Fixes fable-compiler#3862

Author: ncave

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

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<FSharpType>) =
         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 <m/s> 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

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

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 }
 

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 $"{()}"

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
 
 [<AttachMembers>]
 type FooWithAttachedMembers () =
     member x.Bar = 42
-
     static member Foo = FooWithAttachedMembers()
 
+[<Fact>]
+let ``test Passing delegate works`` () = // #3862
+    dtest1 dInvoke |> equal 42
+    dtest2 dInvoke |> equal 43
+
 [<Fact>]
 let ``test Generic unit args work`` () = // #3584
     let to_str = inlineToString (fun (props: unit) -> "s")

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 ()
+
+[<Fact>]
+let ``Passing delegate works`` () = // #3862
+    dtest1 dInvoke |> equal 42
+    dtest2 dInvoke |> equal 43
+
 [<Fact>]
 let ``Generic unit args work`` () = // #3584
     let to_str = inlineToString (fun (props: unit) -> "s")