Added static link tests and extended CompilerAssert

tests/fsharp/Compiler/CodeGen/EmittedIL/StaticLinkTests.fs

@@ -0,0 +1,227 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.UnitTests.CodeGen.EmittedIL
+
+open System.IO
+open System.Reflection
+open FSharp.Compiler.UnitTests
+open NUnit.Framework
+
+[<TestFixture>]
+module StaticLinkTests =
+
+    [<Test>]
+    let ``Static link simple library``() =
+        let module1 =
+            let source =
+                """
+module Module1
+
+type C() = class end
+                """
+            Compilation.Create(source, Fsx, Library)
+
+        let module2 =
+            let source =
+                """
+let y = Module1.C()
+printfn "%A" y
+                """
+            Compilation.Create(source, Fsx, Exe, cmplRefs=[CompilationReference.CreateFSharp(module1, staticLink=true)])
+
+        CompilerAssert.Execute(module2, 
+            beforeExecute=(fun _ deps ->
+                deps
+                |> List.iter (fun dep -> try File.Delete dep with | _ -> ())))
+
+    [<Test>]
+    let ``Simple exe should fail to execute if dependency was not found and is not statically linked``() =
+        let module1 =
+            let source =
+                """
+module Module1
+
+type C() = class end
+                """
+            Compilation.Create(source, Fsx, Library)
+
+        let module2 =
+            let source =
+                """
+let y = Module1.C()
+printfn "%A" y
+                """
+            Compilation.Create(source, Fsx, Exe, cmplRefs=[CompilationReference.CreateFSharp module1])
+
+        Assert.Throws<TargetInvocationException>(fun _ ->
+            CompilerAssert.Execute(module2, 
+                beforeExecute=(fun _ deps ->
+                    deps
+                    |> List.iter (fun dep -> try File.Delete dep with | _ -> ())))) |> ignore
+
+    [<Test>]
+    let ``Simple exe should execute if dependency was found and is not statically linked``() =
+        let module1 =
+            let source =
+                """
+module Module1
+
+type C() = class end
+                """
+            Compilation.Create(source, Fsx, Library)
+
+        let module2 =
+            let source =
+                """
+let y = Module1.C()
+printfn "%A" y
+                """
+            Compilation.Create(source, Fsx, Exe, cmplRefs=[CompilationReference.CreateFSharp module1])
+
+        CompilerAssert.Execute module2
+
+    [<Test>]
+    let ``Static link quotes in multiple modules``() =
+        let module1 =
+            let source =
+                """
+module Module1
+
+module Test =
+    let inline run() = 
+       <@ fun (output:'T[]) (input:'T[]) (length:int) ->
+          let start = 0
+          let mutable i = start
+          while i < length do
+             output.[i] <- input.[i]
+             i <- i + 1 @>
+
+    let bar() = 
+        sprintf "%A" (run())
+
+type C() = 
+
+  [<ReflectedDefinition>]
+  static member F x = (C(), System.DateTime.Now)
+                """
+            Compilation.Create(source, Fsx, Library)
+
+        let module2 =
+            let source =
+                """
+
+let a = Module1.Test.bar()
+let b = sprintf "%A" (Module1.Test.run())
+
+let test1 = (a=b)
+type D() = 
+
+  [<ReflectedDefinition>]
+  static member F x = (Module1.C(), D(), System.DateTime.Now)
+
+
+let z2 = Quotations.Expr.TryGetReflectedDefinition(typeof<Module1.C>.GetMethod("F"))
+let s2 = (sprintf "%2000A" z2) 
+let test2 = (s2 = "Some Lambda (x, NewTuple (NewObject (C), PropertyGet (None, Now, [])))")
+
+let z3 = Quotations.Expr.TryGetReflectedDefinition(typeof<D>.GetMethod("F"))
+let s3 = (sprintf "%2000A" z3) 
+let test3 = (s3 = "Some Lambda (x, NewTuple (NewObject (C), NewObject (D), PropertyGet (None, Now, [])))")
+
+#if EXTRAS
+// Add some references to System.ValueTuple, and add a test case which statically links this DLL
+let test4 = struct (3,4)
+let test5 = struct (z2,z3)
+#endif
+
+if not test1 then 
+    stdout.WriteLine "*** test1 FAILED"; 
+    eprintf "FAILED, in-module result %s is different from out-module call %s" a b
+
+if not test2 then 
+    stdout.WriteLine "*** test2 FAILED"; 
+    eprintf "FAILED, %s is different from expected" s2
+if not test3 then 
+    stdout.WriteLine "*** test3 FAILED"; 
+    eprintf "FAILED, %s is different from expected" s3
+
+
+if test1 && test2 && test3 then ()
+else failwith "Test Failed"
+                """
+            Compilation.Create(source, Fsx, Exe, cmplRefs=[CompilationReference.CreateFSharp(module1, staticLink=true)])
+
+        CompilerAssert.Execute(module2, ignoreWarnings=true)
+
+    [<Test>]
+    let ``Static link quotes in multiple modules - optimized``() =
+        let module1 =
+            let source =
+                """
+module Module1
+
+module Test =
+    let inline run() = 
+       <@ fun (output:'T[]) (input:'T[]) (length:int) ->
+          let start = 0
+          let mutable i = start
+          while i < length do
+             output.[i] <- input.[i]
+             i <- i + 1 @>
+
+    let bar() = 
+        sprintf "%A" (run())
+
+type C() = 
+
+  [<ReflectedDefinition>]
+  static member F x = (C(), System.DateTime.Now)
+                """
+            Compilation.Create(source, Fsx, Library, [|"--optimize+"|])
+
+        let module2 =
+            let source =
+                """
+
+let a = Module1.Test.bar()
+let b = sprintf "%A" (Module1.Test.run())
+
+let test1 = (a=b)
+type D() = 
+
+  [<ReflectedDefinition>]
+  static member F x = (Module1.C(), D(), System.DateTime.Now)
+
+
+let z2 = Quotations.Expr.TryGetReflectedDefinition(typeof<Module1.C>.GetMethod("F"))
+let s2 = (sprintf "%2000A" z2) 
+let test2 = (s2 = "Some Lambda (x, NewTuple (NewObject (C), PropertyGet (None, Now, [])))")
+
+let z3 = Quotations.Expr.TryGetReflectedDefinition(typeof<D>.GetMethod("F"))
+let s3 = (sprintf "%2000A" z3) 
+let test3 = (s3 = "Some Lambda (x, NewTuple (NewObject (C), NewObject (D), PropertyGet (None, Now, [])))")
+
+#if EXTRAS
+// Add some references to System.ValueTuple, and add a test case which statically links this DLL
+let test4 = struct (3,4)
+let test5 = struct (z2,z3)
+#endif
+
+if not test1 then 
+    stdout.WriteLine "*** test1 FAILED"; 
+    eprintf "FAILED, in-module result %s is different from out-module call %s" a b
+
+if not test2 then 
+    stdout.WriteLine "*** test2 FAILED"; 
+    eprintf "FAILED, %s is different from expected" s2
+if not test3 then 
+    stdout.WriteLine "*** test3 FAILED"; 
+    eprintf "FAILED, %s is different from expected" s3
+
+
+if test1 && test2 && test3 then ()
+else failwith "Test Failed"
+                """
+            Compilation.Create(source, Fsx, Exe, [|"--optimize+"|], [CompilationReference.CreateFSharp(module1, staticLink=true)])
+
+        CompilerAssert.Execute(module2, ignoreWarnings=true)

tests/fsharp/Compiler/CompilerAssert.fs

@@ -1,6 +1,7 @@
 // Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
 
-namespace FSharp.Compiler.UnitTests
+[<AutoOpen>]
+module FSharp.Compiler.UnitTests.CompilerAssert
 
 open System
 open System.Diagnostics
@@ -29,17 +30,54 @@ type ILVerifier (dllFilePath: string) =
     member this.VerifyILWithLineNumbers (qualifiedItemName: string, expectedIL: string) =
         ILChecker.checkILItemWithLineNumbers qualifiedItemName dllFilePath [ expectedIL ]
 
-[<RequireQualifiedAccess>]
-module CompilerAssert =
+type Worker () =
+    inherit MarshalByRefObject()
 
-    let checker = FSharpChecker.Create(suggestNamesForErrors=true)
+    member x.ExecuteTestCase assemblyPath (deps: string[]) =
+        AppDomain.CurrentDomain.add_AssemblyResolve(ResolveEventHandler(fun _ args ->
+            deps
+            |> Array.tryFind (fun (x: string) -> Path.GetFileNameWithoutExtension x = args.Name)
+            |> Option.bind (fun x -> if File.Exists x then Some x else None)
+            |> Option.map Assembly.LoadFile
+            |> Option.defaultValue null))
+        let asm = Assembly.LoadFrom(assemblyPath)
+        let entryPoint = asm.EntryPoint
+        (entryPoint.Invoke(Unchecked.defaultof<obj>, [||])) |> ignore
 
-    let private config = TestFramework.initializeSuite ()
+type SourceKind =
+    | Fs
+    | Fsx
+
+type CompileOutput =
+    | Library
+    | Exe
+
+type CompilationReference = private CompilationReference of Compilation * staticLink: bool with
+
+    static member CreateFSharp(cmpl: Compilation, ?staticLink) =
+        let staticLink = defaultArg staticLink false
+        CompilationReference(cmpl, staticLink)
+
+and Compilation = private Compilation of string * SourceKind * CompileOutput * options: string[] * CompilationReference list with
+
+    static member Create(source, sourceKind, output, ?options, ?cmplRefs) =
+        let options = defaultArg options [||]
+        let cmplRefs = defaultArg cmplRefs []
+        Compilation(source, sourceKind, output, options, cmplRefs)
+
+[<Sealed;AbstractClass>]
+type CompilerAssert private () =
+
+    static let checker = FSharpChecker.Create(suggestNamesForErrors=true)
+
+    static let config = TestFramework.initializeSuite ()
+
+    static let _ = config |> ignore
 
 // Do a one time dotnet sdk build to compute the proper set of reference assemblies to pass to the compiler
 #if !NETCOREAPP
 #else
-    let projectFile = """
+    static let projectFile = """
 <Project Sdk="Microsoft.NET.Sdk">
 
   <PropertyGroup>
@@ -56,13 +94,13 @@ module CompilerAssert =
 
 </Project>"""
 
-    let programFs = """
+    static let programFs = """
 open System
 
 [<EntryPoint>]
 let main argv = 0"""
 
-    let getNetCoreAppReferences =
+    static let getNetCoreAppReferences =
         let mutable output = ""
         let mutable errors = ""
         let mutable cleanUp = true
@@ -107,37 +145,35 @@ let main argv = 0"""
 #endif
 
 #if FX_NO_APP_DOMAINS
-    let executeBuiltApp assembly =
+    static let executeBuiltApp assembly deps =
         let ctxt = AssemblyLoadContext("ContextName", true)
         try
             let asm = ctxt.LoadFromAssemblyPath(assembly)
             let entryPoint = asm.EntryPoint
+            ctxt.add_Resolving(fun ctxt name ->
+                deps
+                |> List.tryFind (fun (x: string) -> Path.GetFileNameWithoutExtension x = name.Name)
+                |> Option.map ctxt.LoadFromAssemblyPath
+                |> Option.defaultValue null)
             (entryPoint.Invoke(Unchecked.defaultof<obj>, [||])) |> ignore
         finally
             ctxt.Unload()
 #else
-    type Worker () =
-        inherit MarshalByRefObject()
-
-        member __.ExecuteTestCase assemblyPath =
-            let asm = Assembly.LoadFrom(assemblyPath)
-            let entryPoint = asm.EntryPoint
-            (entryPoint.Invoke(Unchecked.defaultof<obj>, [||])) |> ignore
 
-    let pathToThisDll = Assembly.GetExecutingAssembly().CodeBase
+    static let pathToThisDll = Assembly.GetExecutingAssembly().CodeBase
 
-    let adSetup =
+    static let adSetup =
         let setup = new System.AppDomainSetup ()
         setup.PrivateBinPath <- pathToThisDll
         setup
 
-    let executeBuiltApp assembly =
+    static let executeBuiltApp assembly deps =
         let ad = AppDomain.CreateDomain((Guid()).ToString(), null, adSetup)
         let worker = (ad.CreateInstanceFromAndUnwrap(pathToThisDll, typeof<Worker>.FullName)) :?> Worker
-        worker.ExecuteTestCase assembly |>ignore
+        worker.ExecuteTestCase assembly (deps |> Array.ofList) |>ignore
 #endif
 
-    let private defaultProjectOptions =
+    static let defaultProjectOptions =
         {
             ProjectFileName = "Z:\\test.fsproj"
             ProjectId = None
@@ -159,27 +195,146 @@ let main argv = 0"""
             Stamp = None
         }
 
-    let private gate = obj ()
-
-    let private compile isExe options source f =
-        lock gate <| fun () ->
-            let inputFilePath = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
-            let outputFilePath = Path.ChangeExtension (Path.GetTempFileName(), if isExe then ".exe" else ".dll")
-            try
-                File.WriteAllText (inputFilePath, source)
-                let args =
-                    options
-                    |> Array.append defaultProjectOptions.OtherOptions
-                    |> Array.append [| "fsc.exe"; inputFilePath; "-o:" + outputFilePath; (if isExe then "--target:exe" else "--target:library"); "--nowin32manifest" |]
-                let errors, _ = checker.Compile args |> Async.RunSynchronously
-
-                f (errors, outputFilePath)
+    static let rawCompile inputFilePath outputFilePath isExe options source =
+        File.WriteAllText (inputFilePath, source)
+        let args =
+            options
+            |> Array.append defaultProjectOptions.OtherOptions
+            |> Array.append [| "fsc.exe"; inputFilePath; "-o:" + outputFilePath; (if isExe then "--target:exe" else "--target:library"); "--nowin32manifest" |]
+        let errors, _ = checker.Compile args |> Async.RunSynchronously
 
-            finally
-                try File.Delete inputFilePath with | _ -> ()
-                try File.Delete outputFilePath with | _ -> ()
+        errors, outputFilePath
 
-    let Pass (source: string) =
+    static let compileAux isExe options source f : unit =
+        let inputFilePath = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
+        let outputFilePath = Path.ChangeExtension (Path.GetTempFileName(), if isExe then ".exe" else ".dll")
+        try
+            f (rawCompile inputFilePath outputFilePath isExe options source)
+        finally
+            try File.Delete inputFilePath with | _ -> ()
+            try File.Delete outputFilePath with | _ -> ()
+
+    static let compileDisposable isScript isExe options source =
+        let ext =
+            if isScript then ".fsx"
+            else ".fs"
+        let inputFilePath = Path.ChangeExtension(Path.GetTempFileName(), ext)
+        let outputFilePath = Path.ChangeExtension (Path.GetTempFileName(), if isExe then ".exe" else ".dll")
+        let o =
+            { new IDisposable with
+                member _.Dispose() =
+                    try File.Delete inputFilePath with | _ -> ()
+                    try File.Delete outputFilePath with | _ -> () }
+        try
+            o, rawCompile inputFilePath outputFilePath isExe options source
+        with
+        | _ ->
+            o.Dispose()
+            reraise()
+
+    static let gate = obj ()
+
+    static let compile isExe options source f =
+        lock gate (fun _ -> compileAux isExe options source f)
+
+    static let assertErrors ignoreWarnings (errors: FSharpErrorInfo[]) =
+        let errors = 
+            if ignoreWarnings then
+                errors 
+                |> Array.filter (fun error -> error.Severity <> FSharpErrorSeverity.Warning)
+            else
+                errors
+        if errors.Length > 0 then
+            Assert.Fail(sprintf "%A" errors)
+
+    static let rec compileCompilationAux (disposals: ResizeArray<IDisposable>) ignoreWarnings (cmpl: Compilation) : (FSharpErrorInfo[] * string) * string list =
+        let compilationRefs, deps =
+            match cmpl with
+            | Compilation(_, _, _, _, cmpls) ->
+                let compiledRefs =               
+                    cmpls
+                    |> List.map (fun cmpl ->
+                            match cmpl with
+                            | CompilationReference (cmpl, staticLink) ->
+                                compileCompilationAux disposals ignoreWarnings cmpl, staticLink)
+
+                let compilationRefs =
+                    compiledRefs
+                    |> List.map (fun (((errors, outputFilePath), _), staticLink) ->
+                        assertErrors ignoreWarnings errors
+                        let rOption = "-r:" + outputFilePath
+                        if staticLink then
+                            [rOption;"--staticlink:" + Path.GetFileNameWithoutExtension outputFilePath]
+                        else
+                            [rOption])
+                    |> List.concat
+                    |> Array.ofList
+
+                let deps =
+                    compiledRefs
+                    |> List.map (fun ((_, deps), _) -> deps)
+                    |> List.concat
+                    |> List.distinct
+
+                compilationRefs, deps
+
+        let isScript =
+            match cmpl with
+            | Compilation(_, kind, _, _, _) ->
+                match kind with
+                | Fs -> false
+                | Fsx -> true
+
+        let isExe =
+            match cmpl with
+            | Compilation(_, _, output, _, _) ->
+                match output with
+                | Library -> false
+                | Exe -> true
+
+        let source =
+            match cmpl with
+            | Compilation(source, _, _, _, _) -> source
+
+        let options = 
+            match cmpl with
+            | Compilation(_, _, _, options, _) -> options
+
+        let disposal, res = compileDisposable isScript isExe (Array.append options compilationRefs) source
+        disposals.Add disposal
+
+        let deps2 =
+            compilationRefs
+            |> Array.filter (fun x -> not (x.Contains("--staticlink")))
+            |> Array.map (fun x -> x.Replace("-r:", String.Empty))
+            |> List.ofArray
+
+        res, (deps @ deps2)
+
+    static let rec compileCompilation ignoreWarnings (cmpl: Compilation) f =
+        let disposals = ResizeArray()
+        try
+            f (compileCompilationAux disposals ignoreWarnings cmpl)
+        finally
+            disposals
+            |> Seq.iter (fun x -> x.Dispose())          
+
+    static member Compile(cmpl: Compilation, ?ignoreWarnings) =
+        let ignoreWarnings = defaultArg ignoreWarnings false
+        lock gate (fun () -> 
+            compileCompilation ignoreWarnings cmpl (fun ((errors, _), _) ->
+                assertErrors ignoreWarnings errors))
+
+    static member Execute(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute) =
+        let ignoreWarnings = defaultArg ignoreWarnings false
+        let beforeExecute = defaultArg beforeExecute (fun _ _ -> ())
+        lock gate (fun () -> 
+            compileCompilation ignoreWarnings cmpl (fun ((errors, outputFilePath), deps) ->
+                assertErrors ignoreWarnings errors
+                beforeExecute outputFilePath deps
+                executeBuiltApp outputFilePath deps))
+
+    static member Pass (source: string) =
         lock gate <| fun () ->
             let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously
 
@@ -191,7 +346,7 @@ let main argv = 0"""
 
             Assert.IsEmpty(typeCheckResults.Errors, sprintf "Type Check errors: %A" typeCheckResults.Errors)
 
-    let TypeCheckWithErrorsAndOptions options (source: string) expectedTypeErrors =
+    static member TypeCheckWithErrorsAndOptions options (source: string) expectedTypeErrors =
         lock gate <| fun () ->
             let parseResults, fileAnswer =
                 checker.ParseAndCheckFileInProject(
@@ -222,30 +377,30 @@ let main argv = 0"""
                 Assert.AreEqual(expectedErrorMsg, info.Message, "expectedErrorMsg")
             )
 
-    let TypeCheckWithErrors (source: string) expectedTypeErrors =
-        TypeCheckWithErrorsAndOptions [||] source expectedTypeErrors
+    static member TypeCheckWithErrors (source: string) expectedTypeErrors =
+        CompilerAssert.TypeCheckWithErrorsAndOptions [||] source expectedTypeErrors
 
-    let TypeCheckSingleErrorWithOptions options (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) =
-        TypeCheckWithErrorsAndOptions options source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |]
+    static member TypeCheckSingleErrorWithOptions options (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) =
+        CompilerAssert.TypeCheckWithErrorsAndOptions options source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |]
 
-    let TypeCheckSingleError (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) =
-        TypeCheckWithErrors source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |]
+    static member TypeCheckSingleError (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) =
+        CompilerAssert.TypeCheckWithErrors source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |]
 
-    let CompileExe (source: string) =
+    static member CompileExe (source: string) =
         compile true [||] source (fun (errors, _) ->
             if errors.Length > 0 then
                 Assert.Fail (sprintf "Compile had warnings and/or errors: %A" errors))
 
-    let CompileExeAndRun (source: string) =
+    static member CompileExeAndRun (source: string) =
         compile true [||] source (fun (errors, outputExe) ->
 
             if errors.Length > 0 then
                 Assert.Fail (sprintf "Compile had warnings and/or errors: %A" errors)
 
-            executeBuiltApp outputExe
+            executeBuiltApp outputExe []
         )
 
-    let CompileLibraryAndVerifyILWithOptions options (source: string) (f: ILVerifier -> unit) =
+    static member CompileLibraryAndVerifyILWithOptions options (source: string) (f: ILVerifier -> unit) =
         compile false options source (fun (errors, outputFilePath) ->
             let errors =
                 errors |> Array.filter (fun x -> x.Severity = FSharpErrorSeverity.Error)
@@ -255,10 +410,10 @@ let main argv = 0"""
             f (ILVerifier outputFilePath)
         )
 
-    let CompileLibraryAndVerifyIL (source: string) (f: ILVerifier -> unit) =
-        CompileLibraryAndVerifyILWithOptions [||] source f
+    static member CompileLibraryAndVerifyIL (source: string) (f: ILVerifier -> unit) =
+        CompilerAssert.CompileLibraryAndVerifyILWithOptions [||] source f
 
-    let RunScript (source: string) (expectedErrorMessages: string list) =
+    static member RunScript (source: string) (expectedErrorMessages: string list) =
         lock gate <| fun () ->
             // Intialize output and input streams
             use inStream = new StringReader("")
@@ -294,7 +449,7 @@ let main argv = 0"""
                     Assert.AreEqual(expectedErrorMessage, errorMessage)
             )
 
-    let ParseWithErrors (source: string) expectedParseErrors =
+    static member ParseWithErrors (source: string) expectedParseErrors =
         let sourceFileName = "test.fs"
         let parsingOptions = { FSharpParsingOptions.Default with SourceFiles = [| sourceFileName |] }
         let parseResults = checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunSynchronously

tests/fsharp/FSharpSuite.Tests.fsproj

@@ -34,6 +34,7 @@
     <Compile Include="Compiler\ILChecker.fs" />
     <Compile Include="Compiler\Utilities.fs" />
     <Compile Include="Compiler\CompilerAssert.fs" />
+    <Compile Include="Compiler\CodeGen\EmittedIL\StaticLinkTests.fs" />
     <Compile Include="Compiler\CodeGen\EmittedIL\LiteralValue.fs" />
     <Compile Include="Compiler\CodeGen\EmittedIL\Mutation.fs" />
     <Compile Include="Compiler\CodeGen\EmittedIL\TailCalls.fs" />