Issue #279: Fix FSharpFunc unit type args

src/ProvidedTypes.fs

@@ -13983,7 +13983,21 @@ namespace ProviderImplementation.ProvidedTypes
         let isAddress s = (s = ExpectedStackState.Address)
         let rec emitLambda(callSiteIlg: ILGenerator, v: Var, body: Expr, freeVars: seq<Var>, lambdaLocals: Dictionary<_, ILLocalBuilder>, parameters) =
             let lambda: ILTypeBuilder = assemblyMainModule.DefineType(UNone, genUniqueTypeName(), TypeAttributes.Class)
-            let baseType = convTypeToTgt (typedefof<FSharpFunc<_, _>>.MakeGenericType(v.Type, body.Type))
+
+            let fsharpFuncType = convTypeToTgt (typedefof<FSharpFunc<_, _>>)
+            let voidType = convTypeToTgt typeof<System.Void>
+            let rec lambdaType (t : Type) = 
+                if t.IsGenericType then 
+                    let args = t.GetGenericArguments()
+                    let gdef = t.GetGenericTypeDefinition()
+                    if args.Length = 2 && gdef.FullName = fsharpFuncType.FullName && args.[1] = voidType then 
+                        gdef.MakeGenericType(lambdaType args.[0], typeof<unit>)
+                    else
+                        gdef.MakeGenericType(args |> Array.map lambdaType)
+                else
+                    t
+
+            let baseType = convTypeToTgt (lambdaType (typedefof<FSharpFunc<_, _>>.MakeGenericType(v.Type, body.Type)))
             lambda.SetParent(transType baseType)
             let baseCtor = baseType.GetConstructor(bindAll, null, [| |], null)
             if isNull baseCtor then failwithf "Couldn't find default constructor on %O" baseType
@@ -14013,10 +14027,13 @@ namespace ProviderImplementation.ProvidedTypes
                 ilg.Emit(I_stloc l.LocalIndex)
                 lambdaLocals.[v] <- l
 
-            let expectedState = if (retType = ILType.Void) then ExpectedStackState.Empty else ExpectedStackState.Value
+            let unitType = transType (convTypeToTgt (typeof<unit>))
+            let expectedState = if (retType = ILType.Void || retType.QualifiedName = unitType.QualifiedName) then ExpectedStackState.Empty else ExpectedStackState.Value
             let lambadParamVars = [| Var("this", typeof<obj>); v|]
             let codeGen = CodeGenerator(assemblyMainModule, genUniqueTypeName, implicitCtorArgsAsFields, convTypeToTgt, transType, transFieldSpec, transMeth, transMethRef, transCtorSpec, ilg, lambdaLocals, lambadParamVars)
             codeGen.EmitExpr (expectedState, body)
+            if retType.QualifiedName = unitType.QualifiedName then 
+                ilg.Emit(I_ldnull)
             ilg.Emit(I_ret)
 
             callSiteIlg.Emit(I_newobj (ctor.FormalMethodSpec, None))

tests/FSharp.TypeProviders.SDK.Tests.fsproj

@@ -21,6 +21,7 @@
     <Compile Include="BasicErasedProvisionTests.fs" />
     <Compile Include="BasicGenerativeProvisionTests.fs" />
     <Compile Include="AssemblyReaderTests.fs" />
+    <Compile Include="GeneratedCodeTests.fs" />
     <Compile Include="GeneratedOpTests.fs" />
     <Compile Include="GenerativeEnumsProvisionTests.fs" />
     <Compile Include="Program.fs" Condition="'$(TargetFramework)' == 'netstandard2.0' OR '$(TargetFramework)' == 'netcoreapp3.1' " />

tests/GeneratedCodeTests.fs

@@ -0,0 +1,161 @@
+#if INTERACTIVE
+#load "../src/ProvidedTypes.fsi" "../src/ProvidedTypes.fs" 
+#load "../src/ProvidedTypesTesting.fs"
+
+#else
+
+module TPSDK.GeneratedCodeTests
+#endif
+
+#if !NO_GENERATIVE
+
+open System
+open System.Reflection
+open Microsoft.FSharp.Core.CompilerServices
+open Xunit
+open ProviderImplementation.ProvidedTypes
+open ProviderImplementation.ProvidedTypesTesting
+open Microsoft.FSharp.Quotations
+
+#nowarn "760" // IDisposable needs new
+
+let testCases() = 
+    [("F# 3.1 Portable 259", "3.259.3.1", (fun _ ->  Targets.hasPortable259Assemblies()), Targets.Portable259FSharp31Refs)
+     ("F# 4.0 Portable 259", "3.259.4.0", (fun _ ->  Targets.hasPortable259Assemblies() && Targets.supportsFSharp40()), Targets.Portable259FSharp40Refs)
+     ("F# 3.1 .NET 4.5", "4.3.1.0", (fun _ ->  Targets.supportsFSharp31()), Targets.DotNet45FSharp31Refs)
+     ("F# 4.0 .NET 4.5", "4.4.0.0", (fun _ ->  Targets.supportsFSharp40()), Targets.DotNet45FSharp40Refs)
+     ("F# 4.1 .NET 4.5", "4.4.1.0", (fun _ ->  true), Targets.DotNet45FSharp41Refs)
+     ("F# 4.1 .NET Standard 2.0", "4.4.1.0", (fun _ ->  true), Targets.DotNetStandard20FSharp41Refs)
+     ("F# 4.1 .NET CoreApp 2.0", "4.4.1.0", (fun _ ->  true), Targets.DotNetCoreApp20FSharp41Refs) ]
+
+let possibleVersions = 
+    [ "3.259.3.1"
+      "3.259.4.0"
+      "4.3.1.0"
+      "4.4.0.0"
+      "4.4.1.0"
+      "4.4.3.0"
+      (typeof<list<int>>.Assembly.GetName().Version.ToString()) ]
+
+let hostedTestCases() = 
+    [("4.4.0.0", (fun _ ->  Targets.supportsFSharp40()), Targets.DotNet45FSharp40Refs) ]
+
+
+let testProvidedAssembly exprs = 
+    if Targets.supportsFSharp40() then
+        let runtimeAssemblyRefs = Targets.DotNet45FSharp40Refs()
+        let runtimeAssembly = runtimeAssemblyRefs.[0]
+        let cfg = Testing.MakeSimulatedTypeProviderConfig (__SOURCE_DIRECTORY__, runtimeAssembly, runtimeAssemblyRefs) 
+        let tp = TypeProviderForNamespaces(cfg) //:> TypeProviderForNamespaces
+        let ns = "Tests"
+        let tempAssembly = ProvidedAssembly()
+        let container = ProvidedTypeDefinition(tempAssembly, ns, "Container", Some typeof<obj>, isErased = false)
+        let mutable counter = 0
+
+        let create (expr : Expr) =  
+            counter <- counter + 1
+            let name = sprintf "F%d" counter
+            ProvidedMethod(name,[],expr.Type,invokeCode = (fun _args -> expr), isStatic = true)
+            |> container.AddMember
+            name
+        let names = exprs |> List.map (fst >> create)
+        do tempAssembly.AddTypes [container]
+        do tp.AddNamespace(container.Namespace, [container])
+        let providedNamespace = tp.Namespaces.[0] 
+        let providedTypes  = providedNamespace.GetTypes()
+        let providedType = providedTypes.[0] 
+        let providedTypeDefinition = providedType :?> ProvidedTypeDefinition
+        Assert.Equal("Container", providedTypeDefinition.Name)
+        let test (container : Type) = 
+            let call name = container.GetMethod(name).Invoke(null,[||])
+            (names, exprs)
+            ||> List.iter2 (fun name (_,f) -> f(call name))
+        let assemContents = (tp :> ITypeProvider).GetGeneratedAssemblyContents(providedTypeDefinition.Assembly)
+        let assembly = Assembly.Load assemContents
+        assembly.ExportedTypes |> Seq.find (fun ty -> ty.Name = "Container") |> test
+
+let runningOnMono = try Type.GetType("Mono.Runtime") <> null with _ -> false 
+
+let check (e : Expr<'a>) expected = 
+    e.Raw, fun o -> 
+        let actual = Assert.IsType<'a>(o)
+        Assert.True((expected = actual), sprintf "%A Expected %A got %A. (%A)" (expected.GetType(), actual.GetType(), expected = actual) expected actual e)
+
+let checkExpr (e : Expr<'a>) = 
+    let expected = FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation(e) :?> 'a
+    check e expected
+
+[<Fact>]
+let ``lambdas``() =
+    testProvidedAssembly 
+        [
+            check 
+                <@ 
+                    let a = [|0 .. 10|]
+                    a |> Array.iteri (fun i x -> a.[i] <- x + 1)
+                    a
+                @> [|1 .. 11|]
+            check 
+                <@ 
+                    let a = [|0 .. 10|]
+                    a |> Array.map (fun x -> x + 1)
+                @> [|1 .. 11|]
+            check 
+                <@
+                    let x = ref 0
+                    let f a = 
+                        x := x.Value + a
+                        fun b -> 
+                            x := x.Value + b
+                            fun c -> 
+                                x := x.Value + c
+                    let g = f 1
+                    let x0 = x.Value
+                    let h = g 2
+                    let x1 = x.Value
+                    h 3
+                    x0, x1, x.Value
+                @> (1,3,6)
+            check 
+                <@
+                    let f a b = double a + b
+                    let g() = 1M
+                    f (g()) 123.0
+                @> 124.0
+            check 
+                <@
+                    let rec f x = 
+                        x + "." |> g
+                    and g x =
+                        if x.Length = 5 then 
+                            x
+                        else    
+                            x + "|" |> f
+                    f ""
+                @> ".|.|."
+        ]
+
+[<Fact(Skip = "Need to replace captured mutables with refs")>]
+let ``lambdas - failing``() =
+    testProvidedAssembly 
+        [
+            check 
+                <@
+                    let mutable x = 0
+                    let f a = 
+                        x <- x + a
+                        fun b -> 
+                            x <- x + b
+                            fun c -> 
+                                x <- x + c
+                    let g = f 1
+                    let x0 = x
+                    let h = g 2
+                    let x1 = x
+                    h 3
+                    x0, x1, x
+                @> (1,3,6)
+        ]
+
+
+#endif