diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index c25bcef7b56..4892c4a07fb 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -1937,8 +1937,8 @@ let main1(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener // This is for the compile-from-AST feature of FCS. -// TODO: consider removing this feature from FCS, which as far as I know is not used by anyone. -let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outfile, pdbFile, dllReferences, noframework, exiter, errorLoggerProvider: ErrorLoggerProvider, inputs : ParsedInput list) = +// TODO: consider extracting TC in standalone phase to avoid duplication +let main0OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outfile, pdbFile, dllReferences, noframework, exiter, errorLoggerProvider: ErrorLoggerProvider, disposables : DisposablesTracker, inputs : ParsedInput list) = let tryGetMetadataSnapshot = (fun _ -> None) @@ -1949,7 +1949,20 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, defaultCopyFSharpCore=CopyFSharpCoreFlag.No, tryGetMetadataSnapshot=tryGetMetadataSnapshot) - tcConfigB.framework <- not noframework + let primaryAssembly = + // temporary workaround until https://github.com/dotnet/fsharp/pull/8043 is merged: + // pick a primary assembly based on the current runtime. + // It's an ugly compromise used to avoid exposing primaryAssembly in the public api for this function. + let isNetCoreAppProcess = System.Runtime.InteropServices.RuntimeInformation.FrameworkDescription.StartsWith ".NET Core" + if isNetCoreAppProcess then PrimaryAssembly.System_Runtime + else PrimaryAssembly.Mscorlib + + tcConfigB.target <- target + tcConfigB.primaryAssembly <- primaryAssembly + if noframework then + tcConfigB.framework <- false + tcConfigB.implicitlyResolveAssemblies <- false + // Preset: --optimize+ -g --tailcalls+ (see 4505) SetOptimizeSwitch tcConfigB OptionSwitch.On SetDebugSwitch tcConfigB None ( @@ -1957,9 +1970,10 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, | Some _ -> OptionSwitch.On | None -> OptionSwitch.Off) SetTailcallSwitch tcConfigB OptionSwitch.On - tcConfigB.target <- target - - let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors (tcConfigB, exiter) + + // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) + let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter + let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) tcConfigB.conditionalCompilationDefines <- "COMPILED" :: tcConfigB.conditionalCompilationDefines @@ -1971,11 +1985,27 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, try TcConfig.Create(tcConfigB,validate=false) with e -> + delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 + + let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) + + // Install the global error logger and never remove it. This logger does have all command-line flags considered. + let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + + // Forward all errors from flags + delayForFlagsLogger.CommitDelayedDiagnostics errorLogger + // Resolve assemblies + ReportTime tcConfig "Import mscorlib and FSharp.Core.dll" let foundationalTcConfigP = TcConfigProvider.Constant tcConfig - let sysRes,otherRes,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) - let tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (ctok, foundationalTcConfigP, sysRes, otherRes) |> Cancellable.runWithoutCancellation + let sysRes, otherRes, knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) + + // Import basic assemblies + let tcGlobals, frameworkTcImports = TcImports.BuildFrameworkTcImports (ctok, foundationalTcConfigP, sysRes, otherRes) |> Cancellable.runWithoutCancellation + + // Register framework tcImports to be disposed in future + disposables.Register frameworkTcImports use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) @@ -1983,37 +2013,26 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, let tcConfig = (tcConfig,inputs) ||> List.fold (fun tcc inp -> ApplyMetaCommandsFromInputToTcConfig (tcc, inp,meta)) let tcConfigP = TcConfigProvider.Constant tcConfig - let tcGlobals,tcImports = - let tcImports = TcImports.BuildNonFrameworkTcImports(ctok, tcConfigP, tcGlobals, frameworkTcImports, otherRes,knownUnresolved) |> Cancellable.runWithoutCancellation - tcGlobals,tcImports + // Import other assemblies + ReportTime tcConfig "Import non-system references" + let tcImports = TcImports.BuildNonFrameworkTcImports(ctok, tcConfigP, tcGlobals, frameworkTcImports, otherRes, knownUnresolved) |> Cancellable.runWithoutCancellation + + // register tcImports to be disposed in future + disposables.Register tcImports + // Build the initial type checking environment + ReportTime tcConfig "Typecheck" use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck) let tcEnv0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + // Type check the inputs let tcState, topAttrs, typedAssembly, _tcEnvAtEnd = - TypeCheck(ctok, tcConfig, tcImports, tcGlobals, errorLogger, assemblyName, NiceNameGenerator(), tcEnv0, inputs,exiter) - - let generatedCcu = tcState.Ccu - generatedCcu.Contents.SetAttribs(generatedCcu.Contents.Attribs @ topAttrs.assemblyAttrs) - - use unwindPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.CodeGen) - let signingInfo = ValidateKeySigningAttributes (tcConfig, tcGlobals, topAttrs) + TypeCheck(ctok, tcConfig, tcImports, tcGlobals, errorLogger, assemblyName, NiceNameGenerator(), tcEnv0, inputs, exiter) - // Try to find an AssemblyVersion attribute - let assemVerFromAttrib = - match AttributeHelpers.TryFindVersionAttribute tcGlobals "System.Reflection.AssemblyVersionAttribute" "AssemblyVersionAttribute" topAttrs.assemblyAttrs tcConfig.deterministic with - | Some v -> - match tcConfig.version with - | VersionNone -> Some v - | _ -> warning(Error(FSComp.SR.fscAssemblyVersionAttributeIgnored(),Range.range0)); None - | _ -> None + AbortOnError(errorLogger, exiter) + ReportTime tcConfig "Typechecked" - // Pass on only the minimum information required for the next phase to ensure GC kicks in. - // In principle the JIT should be able to do good liveness analysis to clean things up, but the - // data structures involved here are so large we can't take the risk. - Args(ctok, tcConfig, tcImports, frameworkTcImports, tcGlobals, errorLogger, - generatedCcu, outfile, typedAssembly, topAttrs, pdbFile, assemblyName, - assemVerFromAttrib, signingInfo,exiter) + Args (ctok, tcGlobals, tcImports, frameworkTcImports, tcState.Ccu, typedAssembly, topAttrs, tcConfig, outfile, pdbFile, assemblyName, errorLogger, exiter) /// Phase 2a: encode signature data, optimize, encode optimization data @@ -2205,8 +2224,10 @@ let compileOfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outFile, pdbFile, dllReferences, noframework, exiter, errorLoggerProvider, inputs, tcImportsCapture, dynamicAssemblyCreator) = - main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outFile, pdbFile, - dllReferences, noframework, exiter, errorLoggerProvider, inputs) + use d = new DisposablesTracker() + main0OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outFile, pdbFile, + dllReferences, noframework, exiter, errorLoggerProvider, d, inputs) + |> main1 |> main2a |> main2b (tcImportsCapture, dynamicAssemblyCreator) |> main3 diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index 3ffc2176ed3..c0821183902 100755 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -376,7 +376,7 @@ type public FSharpChecker = /// Enabled debug symbols /// Enables the /noframework flag. /// An optional string used for tracing compiler operations associated with this request. - member CompileToDynamicAssembly: ast:ParsedInput list * assemblyName:string * dependencies:string list * execute:(TextWriter * TextWriter) option * ?debug:bool * ?noframework:bool * ?userOpName: string -> Async + member CompileToDynamicAssembly: ast:ParsedInput list * assemblyName:string * dependencies:string list * execute:(TextWriter * TextWriter) option * ?debug:bool * ?noframework:bool * ?userOpName: string -> Async /// /// Try to get type check results for a file. This looks up the results of recent type checks of the diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 843d6d58399..f50a4783dc7 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -83,7 +83,7 @@ type CompilerAssert private () = static let _ = config |> ignore - // Do a one time dotnet sdk build to compute the proper set of reference assemblies to pass to the compiler +// Do a one time dotnet sdk build to compute the proper set of reference assemblies to pass to the compiler static let projectFile = """ @@ -499,6 +499,58 @@ let main argv = 0""" CompilerAssert.Execute(cmpl, newProcess = true, onOutput = (fun output -> Assert.AreEqual(expectedOutput, output))) /// Assert that the given source code compiles with the `defaultProjectOptions`, with no errors or warnings + static member CompileOfAst isExe source = + let outputFilePath = Path.ChangeExtension (Path.GetTempFileName(), if isExe then "exe" else ".dll") + let parseOptions = { FSharpParsingOptions.Default with SourceFiles = [|"test.fs"|] } + + let parseResults = + checker.ParseFile("test.fs", SourceText.ofString source, parseOptions) + |> Async.RunSynchronously + + Assert.IsEmpty(parseResults.Errors, sprintf "Parse errors: %A" parseResults.Errors) + Assert.IsTrue(parseResults.ParseTree.IsSome, "no parse tree returned") + + let dependencies = + #if NETCOREAPP + Array.toList getNetCoreAppReferences + #else + [] + #endif + + let compileErrors, statusCode = + checker.Compile([parseResults.ParseTree.Value], "test", outputFilePath, dependencies, executable = isExe, noframework = true) + |> Async.RunSynchronously + + Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) + Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode) + outputFilePath + + static member CompileOfAstToDynamicAssembly source = + let assemblyName = sprintf "test-%O" (Guid.NewGuid()) + let parseOptions = { FSharpParsingOptions.Default with SourceFiles = [|"test.fs"|] } + let parseResults = + checker.ParseFile("test.fs", SourceText.ofString source, parseOptions) + |> Async.RunSynchronously + + Assert.IsEmpty(parseResults.Errors, sprintf "Parse errors: %A" parseResults.Errors) + Assert.IsTrue(parseResults.ParseTree.IsSome, "no parse tree returned") + + let dependencies = + #if NETCOREAPP + Array.toList getNetCoreAppReferences + #else + [] + #endif + + let compileErrors, statusCode, assembly = + checker.CompileToDynamicAssembly([parseResults.ParseTree.Value], assemblyName, dependencies, None, noframework = true) + |> Async.RunSynchronously + + Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) + Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode) + Assert.IsTrue(assembly.IsSome, "no assembly returned") + Option.get assembly + static member Pass (source: string) = lock gate <| fun () -> let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously diff --git a/tests/fsharp/Compiler/Infrastructure/AstCompiler.fs b/tests/fsharp/Compiler/Infrastructure/AstCompiler.fs new file mode 100644 index 00000000000..40caa07d3c9 --- /dev/null +++ b/tests/fsharp/Compiler/Infrastructure/AstCompiler.fs @@ -0,0 +1,41 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests.AstCompiler + +open FSharp.Test.Utilities +open NUnit.Framework +open System.Reflection + +[] +module ``AST Compiler Smoke Tests`` = + + [] + let ``Simple E2E module compilation``() = + let assembly = + CompilerAssert.CompileOfAstToDynamicAssembly + """ +module TestModule + + let rec fib n = if n <= 1 then n else fib (n - 2) + fib (n - 1) +""" + + let method = assembly.GetType("TestModule").GetMethod("fib", BindingFlags.Static ||| BindingFlags.Public) + Assert.NotNull(method) + Assert.AreEqual(55, method.Invoke(null, [|10|])) + + [] + let ``Compile to Assembly``() = + let assembly = + CompilerAssert.CompileOfAst false + """ +module LiteralValue + +[] +let x = 7 +""" + + (ILVerifier assembly).VerifyIL [ + """ +.field public static literal int32 x = int32(0x00000007) + """ + ] \ No newline at end of file diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index ae85695c306..006fe4c6e16 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -79,6 +79,7 @@ +