From 5f7a896db4cf3ea80a3d4b1d6650c6694191d39b Mon Sep 17 00:00:00 2001 From: Kevin Malenfant Date: Thu, 27 Jun 2019 09:41:12 -0600 Subject: [PATCH 1/3] fix FSharpFunc type args --- src/ProvidedTypes.fs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/ProvidedTypes.fs b/src/ProvidedTypes.fs index 78ae02f2..69d4713a 100644 --- a/src/ProvidedTypes.fs +++ b/src/ProvidedTypes.fs @@ -13729,7 +13729,21 @@ namespace ProviderImplementation.ProvidedTypes let isAddress s = (s = ExpectedStackState.Address) let rec emitLambda(callSiteIlg: ILGenerator, v: Var, body: Expr, freeVars: seq, lambdaLocals: Dictionary<_, ILLocalBuilder>, parameters) = let lambda: ILTypeBuilder = assemblyMainModule.DefineType(UNone, genUniqueTypeName(), TypeAttributes.Class) - let baseType = convTypeToTgt (typedefof>.MakeGenericType(v.Type, body.Type)) + + let fsharpFuncType = convTypeToTgt (typedefof>) + let voidType = convTypeToTgt typeof + 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) + else + gdef.MakeGenericType(args |> Array.map lambdaType) + else + t + + let baseType = convTypeToTgt (lambdaType (typedefof>.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 From 7872ba9489e146c54eb6aa5def72f820e678e911 Mon Sep 17 00:00:00 2001 From: Kevin Malenfant Date: Tue, 10 Sep 2019 10:39:20 -0600 Subject: [PATCH 2/3] return null for unit lambda return type --- src/ProvidedTypes.fs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/ProvidedTypes.fs b/src/ProvidedTypes.fs index 6742cb2b..f9310568 100644 --- a/src/ProvidedTypes.fs +++ b/src/ProvidedTypes.fs @@ -13989,10 +13989,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)) + let expectedState = if (retType = ILType.Void || retType.QualifiedName = unitType.QualifiedName) then ExpectedStackState.Empty else ExpectedStackState.Value let lambadParamVars = [| Var("this", typeof); 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)) From f2f7fa828eacd59f5624f4db4e3476539bd3869b Mon Sep 17 00:00:00 2001 From: Kevin Malenfant Date: Tue, 10 Sep 2019 10:57:26 -0600 Subject: [PATCH 3/3] test lambda code generation --- tests/FSharp.TypeProviders.SDK.Tests.fsproj | 1 + tests/GeneratedCodeTests.fs | 161 ++++++++++++++++++++ 2 files changed, 162 insertions(+) create mode 100644 tests/GeneratedCodeTests.fs diff --git a/tests/FSharp.TypeProviders.SDK.Tests.fsproj b/tests/FSharp.TypeProviders.SDK.Tests.fsproj index 873b8dc0..1f3ade03 100644 --- a/tests/FSharp.TypeProviders.SDK.Tests.fsproj +++ b/tests/FSharp.TypeProviders.SDK.Tests.fsproj @@ -21,6 +21,7 @@ + diff --git a/tests/GeneratedCodeTests.fs b/tests/GeneratedCodeTests.fs new file mode 100644 index 00000000..3529589f --- /dev/null +++ b/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>.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, 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 + +[] +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 "" + @> ".|.|." + ] + +[] +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 \ No newline at end of file