From 7f4293c10cb3be9cf08aa5e6a0c07eb89b4802ef Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 6 Jan 2020 11:03:21 -0800 Subject: [PATCH] Added static link tests and extended CompilerAssert (#8101) * Changed CompilerAssert to static class. Added Compile/Execute methods that take a Compilation description. Added static link tests * Hiding compilation description internals * Added another test to check for sanity * Making a few optional parameters * Hiding internals of CompilationReference --- .../CodeGen/EmittedIL/StaticLinkTests.fs | 227 +++++++++++++++ tests/fsharp/Compiler/CompilerAssert.fs | 265 ++++++++++++++---- tests/fsharp/FSharpSuite.Tests.fsproj | 1 + 3 files changed, 438 insertions(+), 55 deletions(-) create mode 100644 tests/fsharp/Compiler/CodeGen/EmittedIL/StaticLinkTests.fs diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/StaticLinkTests.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/StaticLinkTests.fs new file mode 100644 index 00000000000..8d47ba7dd7e --- /dev/null +++ b/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 + +[] +module StaticLinkTests = + + [] + 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 | _ -> ()))) + + [] + 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(fun _ -> + CompilerAssert.Execute(module2, + beforeExecute=(fun _ deps -> + deps + |> List.iter (fun dep -> try File.Delete dep with | _ -> ())))) |> ignore + + [] + 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 + + [] + 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() = + + [] + 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() = + + [] + static member F x = (Module1.C(), D(), System.DateTime.Now) + + +let z2 = Quotations.Expr.TryGetReflectedDefinition(typeof.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.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) + + [] + 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() = + + [] + 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() = + + [] + static member F x = (Module1.C(), D(), System.DateTime.Now) + + +let z2 = Quotations.Expr.TryGetReflectedDefinition(typeof.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.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) \ No newline at end of file diff --git a/tests/fsharp/Compiler/CompilerAssert.fs b/tests/fsharp/Compiler/CompilerAssert.fs index 1c753cd25e0..11e886a055d 100644 --- a/tests/fsharp/Compiler/CompilerAssert.fs +++ b/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 +[] +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 ] -[] -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, [||])) |> 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) + +[] +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 = """ @@ -56,13 +94,13 @@ module CompilerAssert = """ - let programFs = """ + static let programFs = """ open System [] 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, [||])) |> 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, [||])) |> 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.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) 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 diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 563358e1a1f..baec3523e1d 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -34,6 +34,7 @@ +