1+ #if INTERACTIVE
2+ #load " ../src/ProvidedTypes.fsi" " ../src/ProvidedTypes.fs"
3+ #load " ../src/ProvidedTypesTesting.fs"
4+
5+ #else
6+
7+ module TPSDK.GeneratedCodeTests
8+ #endif
9+
10+ #if ! NO_ GENERATIVE
11+
12+ open System
13+ open System.Reflection
14+ open Microsoft.FSharp .Core .CompilerServices
15+ open Xunit
16+ open ProviderImplementation.ProvidedTypes
17+ open ProviderImplementation.ProvidedTypesTesting
18+ open Microsoft.FSharp .Quotations
19+
20+ #nowarn " 760" // IDisposable needs new
21+
22+ let testCases () =
23+ [( " F# 3.1 Portable 259" , " 3.259.3.1" , ( fun _ -> Targets.hasPortable259Assemblies()), Targets.Portable259FSharp31Refs)
24+ ( " F# 4.0 Portable 259" , " 3.259.4.0" , ( fun _ -> Targets.hasPortable259Assemblies() && Targets.supportsFSharp40()), Targets.Portable259FSharp40Refs)
25+ ( " F# 3.1 .NET 4.5" , " 4.3.1.0" , ( fun _ -> Targets.supportsFSharp31()), Targets.DotNet45FSharp31Refs)
26+ ( " F# 4.0 .NET 4.5" , " 4.4.0.0" , ( fun _ -> Targets.supportsFSharp40()), Targets.DotNet45FSharp40Refs)
27+ ( " F# 4.1 .NET 4.5" , " 4.4.1.0" , ( fun _ -> true ), Targets.DotNet45FSharp41Refs)
28+ ( " F# 4.1 .NET Standard 2.0" , " 4.4.1.0" , ( fun _ -> true ), Targets.DotNetStandard20FSharp41Refs)
29+ ( " F# 4.1 .NET CoreApp 2.0" , " 4.4.1.0" , ( fun _ -> true ), Targets.DotNetCoreApp20FSharp41Refs) ]
30+
31+ let possibleVersions =
32+ [ " 3.259.3.1"
33+ " 3.259.4.0"
34+ " 4.3.1.0"
35+ " 4.4.0.0"
36+ " 4.4.1.0"
37+ " 4.4.3.0"
38+ ( typeof< list< int>>. Assembly.GetName() .Version.ToString()) ]
39+
40+ let hostedTestCases () =
41+ [( " 4.4.0.0" , ( fun _ -> Targets.supportsFSharp40()), Targets.DotNet45FSharp40Refs) ]
42+
43+
44+ let testProvidedAssembly exprs =
45+ if Targets.supportsFSharp40() then
46+ let runtimeAssemblyRefs = Targets.DotNet45FSharp40Refs()
47+ let runtimeAssembly = runtimeAssemblyRefs.[ 0 ]
48+ let cfg = Testing.MakeSimulatedTypeProviderConfig (__ SOURCE_ DIRECTORY__, runtimeAssembly, runtimeAssemblyRefs)
49+ let tp = TypeProviderForNamespaces( cfg) //:> TypeProviderForNamespaces
50+ let ns = " Tests"
51+ let tempAssembly = ProvidedAssembly()
52+ let container = ProvidedTypeDefinition( tempAssembly, ns, " Container" , Some typeof< obj>, isErased = false )
53+ let mutable counter = 0
54+
55+ let create ( expr : Expr ) =
56+ counter <- counter + 1
57+ let name = sprintf " F%d "
58+ ProvidedMethod( name,[], expr.Type, invokeCode = ( fun _args -> expr), isStatic = true )
59+ |> container.AddMember
60+ name
61+ let names = exprs |> List.map ( fst >> create)
62+ do tempAssembly.AddTypes [ container]
63+ do tp.AddNamespace( container.Namespace, [ container])
64+ let providedNamespace = tp.Namespaces.[ 0 ]
65+ let providedTypes = providedNamespace.GetTypes()
66+ let providedType = providedTypes.[ 0 ]
67+ let providedTypeDefinition = providedType :?> ProvidedTypeDefinition
68+ Assert.Equal( " Container" , providedTypeDefinition.Name)
69+ let test ( container : Type ) =
70+ let call name = container.GetMethod( name) .Invoke( null ,[||])
71+ ( names, exprs)
72+ ||> List.iter2 ( fun name ( _ , f ) -> ( call name))
73+ let assemContents = ( tp :> ITypeProvider) .GetGeneratedAssemblyContents( providedTypeDefinition.Assembly)
74+ let assembly = Assembly.Load assemContents
75+ assembly.ExportedTypes |> Seq.find ( fun ty -> ty.Name = " Container" ) |> test
76+
77+ let runningOnMono = try Type.GetType( " Mono.Runtime" ) <> null with _ -> false
78+
79+ let check ( e : Expr < 'a >) expected =
80+ e.Raw, fun o ->
81+ let actual = Assert.IsType< 'a>( o)
82+ Assert.True(( expected = actual), sprintf " %A %A %A %A " ( expected.GetType(), actual.GetType(), expected = actual) expected actual e)
83+
84+ let checkExpr ( e : Expr < 'a >) =
85+ let expected = FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation( e) :?> 'a
86+ check e expected
87+
88+ [<Fact>]
89+ let ``lambdas`` () =
90+ testProvidedAssembly
91+ [
92+ check
93+ <@
94+ let a = [| 0 .. 10 |]
95+ a |> Array.iteri ( fun i x -> a.[ i] <- x + 1 )
96+ a
97+ @> [| 1 .. 11 |]
98+ check
99+ <@
100+ let a = [| 0 .. 10 |]
101+ a |> Array.map ( fun x -> x + 1 )
102+ @> [| 1 .. 11 |]
103+ check
104+ <@
105+ let x = ref 0
106+ let f a =
107+ x := x.Value + a
108+ fun b ->
109+ x := x.Value + b
110+ fun c ->
111+ x := x.Value + c
112+ let g = f 1
113+ let x0 = x.Value
114+ let h = g 2
115+ let x1 = x.Value
116+ h 3
117+ x0, x1, x.Value
118+ @> ( 1 , 3 , 6 )
119+ check
120+ <@
121+ let f a b = double a + b
122+ let g () = 1 M
123+ f ( g()) 123.0
124+ @> 124.0
125+ check
126+ <@
127+ let rec f x =
128+ x + " ." |> g
129+ and g x =
130+ if x.Length = 5 then
131+ x
132+ else
133+ x + " |" |> f
134+ f " "
135+ @> " .|.|."
136+ ]
137+
138+ [<Fact( Skip = " Need to replace captured mutables with refs" ) >]
139+ let ``lambdas - failing`` () =
140+ testProvidedAssembly
141+ [
142+ check
143+ <@
144+ let mutable x = 0
145+ let f a =
146+ x <- x + a
147+ fun b ->
148+ x <- x + b
149+ fun c ->
150+ x <- x + c
151+ let g = f 1
152+ let x0 = x
153+ let h = g 2
154+ let x1 = x
155+ h 3
156+ x0, x1, x
157+ @> ( 1 , 3 , 6 )
158+ ]
159+
160+
161+ #endif
0 commit comments