Fix AST compilation in netcoreapp

src/fsharp/fsc.fs

@@ -1945,8 +1945,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)
 
@@ -1957,17 +1957,31 @@ 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 (
         match pdbFile with
         | 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
 
@@ -1979,49 +1993,54 @@ 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) 
 
     let meta = Directory.GetCurrentDirectory()
     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
@@ -2213,8 +2232,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

src/fsharp/service/service.fsi

@@ -339,7 +339,7 @@ type public FSharpChecker =
     /// </summary>
     ///
     /// <param name="userOpName">An optional string used for tracing compiler operations associated with this request.</param>
-    member CompileToDynamicAssembly: ast:ParsedInput list * assemblyName:string * dependencies:string list * execute:(TextWriter * TextWriter) option * ?debug:bool * ?noframework:bool  * ?userOpName: string -> Async<FSharpErrorInfo [] * int * System.Reflection.Assembly option>
+    member CompileToDynamicAssembly: ast:ParsedInput list * assemblyName:string * dependencies:string list * execute:(TextWriter * TextWriter) option * ?debug:bool * ?noframework:bool * ?userOpName: string -> Async<FSharpErrorInfo [] * int * System.Reflection.Assembly option>
 
     /// <summary>
     /// Try to get type check results for a file. This looks up the results of recent type checks of the

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 = """
 <Project Sdk="Microsoft.NET.Sdk">
 
@@ -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

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
+
+[<TestFixture>]
+module ``AST Compiler Smoke Tests`` =
+
+    [<Test>]
+    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|]))
+
+    [<Test>]
+    let ``Compile to Assembly``() =
+        let assembly = 
+            CompilerAssert.CompileOfAst false
+                """
+module LiteralValue
+
+[<Literal>]
+let x = 7
+"""
+
+        (ILVerifier assembly).VerifyIL [
+            """
+.field public static literal int32 x = int32(0x00000007)
+            """
+        ]

tests/fsharp/FSharpSuite.Tests.fsproj

@@ -81,6 +81,7 @@
     <Compile Include="Compiler\Libraries\Core\Reflection\SprintfTests.fs" />
     <Compile Include="Compiler\Libraries\Core\Reflection\PreComputedTupleConstructorTests.fs" />
     <Compile Include="Compiler\Libraries\Core\Unchecked\DefaultOfTests.fs" />
+    <Compile Include="Compiler\Infrastructure\AstCompiler.fs" />
     <None Include="app.config" />
     <None Include="update.base.line.with.actuals.fsx" />
     <!-- don't include test resources in subdirectories -->