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 @@
+