From d984cc90c1efa65657cd7a33cf1665e3b2423b4e Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Tue, 9 Jul 2024 18:20:23 -0700 Subject: [PATCH] Fixes #3862 --- src/Fable.Cli/CHANGELOG.md | 4 +++ src/Fable.Transforms/FSharp2Fable.Util.fs | 33 ++++++++++++----------- src/Fable.Transforms/FSharp2Fable.fs | 11 ++++---- src/fable-library-rust/Cargo.toml | 2 +- tests/Js/Main/MiscTests.fs | 18 +++++++++++++ tests/Python/TestMisc.fs | 20 +++++++++++++- tests/Rust/tests/src/MiscTests.fs | 19 +++++++++++++ 7 files changed, 84 insertions(+), 23 deletions(-) diff --git a/src/Fable.Cli/CHANGELOG.md b/src/Fable.Cli/CHANGELOG.md index 2c42778859..70d1662b18 100644 --- a/src/Fable.Cli/CHANGELOG.md +++ b/src/Fable.Cli/CHANGELOG.md @@ -7,6 +7,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## Unreleased +### Fixed + +* [All] Fixed passing delegates with unit args (#3862) (by @ncave) + ## 4.19.3 - 2024-06-17 ### Fixed diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 41bf908e54..771af46a45 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -762,8 +762,8 @@ module Helpers = atts |> Seq.tryPick (fun att -> match (nonAbbreviatedDefinition att.AttributeType).TryFullName with - | Some fullName' -> - if fullName = fullName' then + | Some fullName2 -> + if fullName = fullName2 then Some att else None @@ -932,13 +932,13 @@ module Helpers = } /// Test if the name corresponds to this interface or anyone in its hierarchy - let rec testInterfaceHierarchy interfaceFullname interfaceType = + let rec testInterfaceHierarchy interfaceFullName interfaceType = match tryDefinition interfaceType with - | Some(e, Some fullname2) -> - if interfaceFullname = fullname2 then + | Some(e, Some fullName) -> + if interfaceFullName = fullName then true else - e.DeclaredInterfaces |> Seq.exists (testInterfaceHierarchy interfaceFullname) + e.DeclaredInterfaces |> Seq.exists (testInterfaceHierarchy interfaceFullName) | _ -> false let hasParamArray (memb: FSharpMemberOrFunctionOrValue) = @@ -1111,7 +1111,7 @@ module Patterns = | Let((_, value, _), // Coercion to seq Let((_, Call(None, meth, _, [], []), _), TryFinally(WhileLoop(_, Let((ident, _, _), body), _), _, _, _))) | Let((_, Call(Some value, meth, _, [], []), _), TryFinally(WhileLoop(_, Let((ident, _, _), body), _), _, _, _)) when - // Using only the compiled name is riskier but with the fullname we miss some cases + // Using only the compiled name is riskier but with the fullName we miss some cases // TODO: Check the return type of meth is or implements IEnumerator meth.CompiledName = "GetEnumerator" -> @@ -1432,11 +1432,11 @@ module TypeHelpers = let private getMeasureFullName (genArgs: IList) = if genArgs.Count > 0 then // TODO: Check it's effectively measure? - // TODO: Raise error if we cannot get the measure fullname? + // TODO: Raise error if we cannot get the measure fullName? match tryDefinition genArgs[0] with - | Some(_, Some fullname) -> + | Some(_, Some fullName) -> // Not sure why, but when precompiling F# changes measure types to MeasureProduct<'M, MeasureOne> - match fullname with + match fullName with | Types.measureProduct2 -> match (nonAbbreviatedType genArgs[0]).GenericArguments @@ -1445,8 +1445,8 @@ module TypeHelpers = with // TODO: generalize it to support aggregate units such as or more complex | [ Some measure; Some Types.measureOne ] -> measure - | _ -> fullname - | _ -> fullname + | _ -> fullName + | _ -> fullName | _ -> Naming.unknown else Naming.unknown @@ -2289,7 +2289,7 @@ module Util = | _ -> not (isGlobalOrImportedFSharpEntity ent || isAttachMembersEntity com ent) let getMangledAbstractMemberName (ent: FSharpEntity) memberName overloadHash = - // TODO: Error if entity doesn't have fullname? + // TODO: Error if entity doesn't have fullName? let entityName = defaultArg ent.TryFullName "" entityName + "." + memberName + overloadHash @@ -2756,11 +2756,12 @@ module Util = | _ -> // If member looks like a value but behaves like a function (has generic args) the type from F# AST is wrong (#2045). - let typ = makeType ctx.GenericArgs memb.ReturnParameter.Type + let typ = makeType ctx.GenericArgs memb.FullType + let retTyp = makeType ctx.GenericArgs memb.ReturnParameter.Type let callExpr = - memberIdent com r Fable.Any memb membRef - |> makeCall r typ { callInfo with Tags = "value" :: callInfo.Tags } + memberIdent com r typ memb membRef + |> makeCall r retTyp { callInfo with Tags = "value" :: callInfo.Tags } let fableMember = FsMemberFunctionOrValue(memb) // TODO: Move plugin application to FableTransforms diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 48b63417b4..eae56943c6 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -471,10 +471,11 @@ let private transformDelegate com ctx (delegateType: FSharpType) expr = // applies a unit arg to the expression, see #2400 let expr = match tryDefinition delegateType with - | Some(_, Some "System.Func`1") -> + | Some(_, Some _fullName) -> match expr with - | Fable.CurriedApply(expr, [ Fable.Value(Fable.UnitConstant, _) ], _, _) -> expr - | Fable.Call(expr, { Args = [ Fable.Value(Fable.UnitConstant, _) ] }, _, _) -> expr + | Fable.CurriedApply(expr2, [ Fable.Value(Fable.UnitConstant, _) ], _, _) -> expr2 + | Fable.Call(expr2, { Args = [ Fable.Value(Fable.UnitConstant, _) ] }, _, _) -> // expr2 + Fable.Delegate([], expr, None, Fable.Tags.empty) | _ -> expr | _ -> expr @@ -2103,8 +2104,8 @@ let getRootModule (declarations: FSharpImplementationFileDeclaration list) = let resolveFieldType (ctx: Context) (entityType: FSharpType) (fieldType: FSharpType) = let entityGenArgs = match tryDefinition entityType with - | Some(def, _) when def.GenericParameters.Count = entityType.GenericArguments.Count -> - Seq.zip def.GenericParameters entityType.GenericArguments + | Some(tdef, _) when tdef.GenericParameters.Count = entityType.GenericArguments.Count -> + Seq.zip tdef.GenericParameters entityType.GenericArguments |> Seq.map (fun (p, a) -> genParamName p, makeType Map.empty a) |> Map | _ -> Map.empty diff --git a/src/fable-library-rust/Cargo.toml b/src/fable-library-rust/Cargo.toml index 2a96b2301f..a1783daa53 100644 --- a/src/fable-library-rust/Cargo.toml +++ b/src/fable-library-rust/Cargo.toml @@ -26,7 +26,7 @@ num-integer = { version = "0.1", optional = true } num-traits = { version = "0.2", optional = true } rust_decimal = { version = "1.35", features = ["maths"], default-features = false, optional = true } futures = { version = "0.3", features = ["executor", "thread-pool"], optional = true } -uuid = { version = "1.8", features = ["v4"], default-features = false, optional = true } +uuid = { version = "1.10", features = ["v4"], default-features = false, optional = true } chrono = { version = "0.4", optional = true } regex = { version = "1.10", optional = true } diff --git a/tests/Js/Main/MiscTests.fs b/tests/Js/Main/MiscTests.fs index f737621f55..c6f5909eaf 100644 --- a/tests/Js/Main/MiscTests.fs +++ b/tests/Js/Main/MiscTests.fs @@ -481,9 +481,27 @@ let inline inlineToString (f: 'T -> string): 'T -> string = let unused = f fun a -> $"{a}" +type MyIntDelegate = delegate of unit -> int + +let get42 () = 42 + +let dtest1 (f: MyIntDelegate -> int) = + f get42 + +let dtest2 (f: MyIntDelegate -> int) = + let get43 () = 43 + f get43 + +let dInvoke (d: MyIntDelegate) = + d.Invoke () + let tests = testList "Miscellaneous" [ + testCase "Passing delegate works" <| fun _ -> // #3862 + dtest1 dInvoke |> equal 42 + dtest2 dInvoke |> equal 43 + testCase "Generic unit args work" <| fun _ -> // #3584 let to_str = inlineToString (fun (props: unit) -> "s") to_str () |> equal $"{()}" diff --git a/tests/Python/TestMisc.fs b/tests/Python/TestMisc.fs index ee3a52a958..74c35b5bd3 100644 --- a/tests/Python/TestMisc.fs +++ b/tests/Python/TestMisc.fs @@ -451,14 +451,32 @@ let inline inlineToString (f: 'T -> string): 'T -> string = let unused = f fun a -> $"{a}" +type MyIntDelegate = delegate of unit -> int + +let get42 () = 42 + +let dtest1 (f: MyIntDelegate -> int) = + f get42 + +let dtest2 (f: MyIntDelegate -> int) = + let get43 () = 43 + f get43 + +let dInvoke (d: MyIntDelegate) = + d.Invoke () + type Union_TestUnionTag = Union_TestUnionTag of int [] type FooWithAttachedMembers () = member x.Bar = 42 - static member Foo = FooWithAttachedMembers() +[] +let ``test Passing delegate works`` () = // #3862 + dtest1 dInvoke |> equal 42 + dtest2 dInvoke |> equal 43 + [] let ``test Generic unit args work`` () = // #3584 let to_str = inlineToString (fun (props: unit) -> "s") diff --git a/tests/Rust/tests/src/MiscTests.fs b/tests/Rust/tests/src/MiscTests.fs index 43ffc3dd3e..21b0000f85 100644 --- a/tests/Rust/tests/src/MiscTests.fs +++ b/tests/Rust/tests/src/MiscTests.fs @@ -506,6 +506,25 @@ let inline inlineToString (f: 'T -> string): 'T -> string = let unused = f fun a -> sprintf "%A" a +type MyIntDelegate = delegate of unit -> int + +let get42 () = 42 + +let dtest1 (f: MyIntDelegate -> int) = + f get42 + +let dtest2 (f: MyIntDelegate -> int) = + let get43 () = 43 + f get43 + +let dInvoke (d: MyIntDelegate) = + d.Invoke () + +[] +let ``Passing delegate works`` () = // #3862 + dtest1 dInvoke |> equal 42 + dtest2 dInvoke |> equal 43 + [] let ``Generic unit args work`` () = // #3584 let to_str = inlineToString (fun (props: unit) -> "s")