iron things out

Author: majocha

src/Compiler/Driver/CompilerImports.fs

@@ -1735,7 +1735,7 @@ and [<Sealed>] TcImports
             m
         ) =
 
-        let startingErrorCount = DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount
+        let startingErrorCount = DiagnosticsAsyncState.DiagnosticsLogger.ErrorCount
 
         // Find assembly level TypeProviderAssemblyAttributes. These will point to the assemblies that
         // have class which implement ITypeProvider and which have TypeProviderAttribute on them.
@@ -1936,7 +1936,7 @@ and [<Sealed>] TcImports
                     with RecoverableException e ->
                         errorRecovery e m
 
-                if startingErrorCount < DiagnosticsThreadStatics.DiagnosticsLogger.ErrorCount then
+                if startingErrorCount < DiagnosticsAsyncState.DiagnosticsLogger.ErrorCount then
                     error (Error(FSComp.SR.etOneOrMoreErrorsSeenDuringExtensionTypeSetting (), m))
 
             providers
@@ -2238,15 +2238,17 @@ and [<Sealed>] TcImports
                 | ParallelReferenceResolution.On -> Async.Parallel
                 | ParallelReferenceResolution.Off -> Async.SequentialFailFast
 
-            let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
+            use captureTasks = new CaptureDiagnosticsConcurrently(DiagnosticsAsyncState.DiagnosticsLogger)
+
             let! results =
                 nms
                 |> List.map (fun nm ->
                     async {
                         try
                             return! tcImports.TryRegisterAndPrepareToImportReferencedDll(ctok, nm)
                         with e ->
-                            use _ = UseDiagnosticsLogger diagnosticsLogger
+                            use _ = UseDiagnosticsLogger captureTasks.LoggerForTask
+
                             errorR (Error(FSComp.SR.buildProblemReadingAssembly (nm.resolvedPath, e.Message), nm.originalReference.Range))
                             return None
                     })

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -1828,7 +1828,7 @@ let CheckMultipleInputsUsingGraphMode
             |> Graph.writeMermaidToFile graphFile)
 
     let _ = ctok // TODO Use it
-    let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
+    let diagnosticsLogger = DiagnosticsAsyncState.DiagnosticsLogger
 
     // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
     // somewhere in the files processed prior to each one, or in the processing of this particular file.

src/Compiler/Facilities/AsyncMemoize.fs

@@ -354,15 +354,15 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T
                                                 log (Restarted, key)
                                                 Interlocked.Increment &restarted |> ignore
                                                 System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}"
-                                                let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger
-                                                DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger
+                                                let currentLogger = DiagnosticsAsyncState.DiagnosticsLogger
+                                                DiagnosticsAsyncState.DiagnosticsLogger <- cachingLogger
 
                                                 try
                                                     let! result = computation
                                                     post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics)))
                                                     return ()
                                                 finally
-                                                    DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger
+                                                    DiagnosticsAsyncState.DiagnosticsLogger <- currentLogger
                                             with
                                             | TaskCancelled _ ->
                                                 Interlocked.Increment &cancel_exception_subsequent |> ignore
@@ -484,7 +484,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T
         async {
             let! ct = Async.CancellationToken
 
-            let callerDiagnosticLogger = DiagnosticsThreadStatics.DiagnosticsLogger
+            let callerDiagnosticLogger = DiagnosticsAsyncState.DiagnosticsLogger
 
             match!
                 processRequest post (key, GetOrCompute(computation, ct)) callerDiagnosticLogger
@@ -500,8 +500,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T
                         Async.StartAsTask(
                             async {
                                 // TODO: Should unify starting and restarting
-                                let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger
-                                DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger
+                                let currentLogger = DiagnosticsAsyncState.DiagnosticsLogger
+                                DiagnosticsAsyncState.DiagnosticsLogger <- cachingLogger
 
                                 log (Started, key)
 
@@ -510,7 +510,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T
                                     post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics)))
                                     return result
                                 finally
-                                    DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger
+                                    DiagnosticsAsyncState.DiagnosticsLogger <- currentLogger
                             },
                             cancellationToken = linkedCtSource.Token
                         )

src/Compiler/Facilities/DiagnosticsLogger.fs

@@ -401,25 +401,23 @@ type ConcurrentCapturingDiagnosticsLogger(nm, ?eagerFormat) =
         errors |> Array.iter diagnosticsLogger.DiagnosticSink
 
 /// Type holds thread-static globals for use by the compiler.
-type DiagnosticsThreadStatics =
-    static let buildPhase = new AsyncLocal<BuildPhase>()
-    static let diagnosticsLogger = new AsyncLocal<DiagnosticsLogger>()
+type DiagnosticsAsyncState =
+    static let buildPhase = new AsyncLocal<BuildPhase voption>()
+    static let diagnosticsLogger = new AsyncLocal<DiagnosticsLogger voption>()
 
-    static let EnsureCreated (h: AsyncLocal<_>) d =
-        if box h.Value |> isNull then
-            h.Value <- d
+    static let getOrCreate (holder: AsyncLocal<_>) defaultValue =
+        holder.Value
+        |> ValueOption.defaultWith (fun () ->
+            holder.Value <- ValueSome defaultValue
+            defaultValue)
 
     static member BuildPhase
-        with get () =
-            EnsureCreated buildPhase BuildPhase.DefaultPhase
-            buildPhase.Value
-        and set v = buildPhase.Value <- v
+        with get () = getOrCreate buildPhase BuildPhase.DefaultPhase
+        and set v = buildPhase.Value <- ValueSome v
 
     static member DiagnosticsLogger
-        with get () =
-            EnsureCreated diagnosticsLogger AssertFalseDiagnosticsLogger
-            diagnosticsLogger.Value
-        and set v = diagnosticsLogger.Value <- v
+        with get () = getOrCreate diagnosticsLogger AssertFalseDiagnosticsLogger
+        and set v = diagnosticsLogger.Value <- ValueSome v
 
 [<AutoOpen>]
 module DiagnosticsLoggerExtensions =
@@ -461,7 +459,7 @@ module DiagnosticsLoggerExtensions =
             | ReportedError _ ->
                 PreserveStackTrace exn
                 raise exn
-            | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, DiagnosticsThreadStatics.BuildPhase), severity)
+            | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, DiagnosticsAsyncState.BuildPhase), severity)
 
         member x.ErrorR exn =
             x.EmitDiagnostic(exn, FSharpDiagnosticSeverity.Error)
@@ -521,45 +519,32 @@ module DiagnosticsLoggerExtensions =
 
 /// NOTE: The change will be undone when the returned "unwind" object disposes
 let UseBuildPhase (phase: BuildPhase) =
-    let oldBuildPhase = DiagnosticsThreadStatics.BuildPhase
-    DiagnosticsThreadStatics.BuildPhase <- phase
+    let oldBuildPhase = DiagnosticsAsyncState.BuildPhase
+    DiagnosticsAsyncState.BuildPhase <- phase
 
     { new IDisposable with
         member x.Dispose() =
-            DiagnosticsThreadStatics.BuildPhase <- oldBuildPhase
+            DiagnosticsAsyncState.BuildPhase <- oldBuildPhase
     }
 
 /// NOTE: The change will be undone when the returned "unwind" object disposes
 let UseTransformedDiagnosticsLogger (transformer: DiagnosticsLogger -> #DiagnosticsLogger) =
-    let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger
-    DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger
+    let oldLogger = DiagnosticsAsyncState.DiagnosticsLogger
+    DiagnosticsAsyncState.DiagnosticsLogger <- transformer oldLogger
 
     { new IDisposable with
         member _.Dispose() =
-            DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger
+            DiagnosticsAsyncState.DiagnosticsLogger <- oldLogger
     }
 
 let UseDiagnosticsLogger newLogger =
     UseTransformedDiagnosticsLogger(fun _ -> newLogger)
 
-let CaptureDiagnosticsConcurrently () =
-    let newLogger =
-        ConcurrentCapturingDiagnosticsLogger("CaptureDiagnosticsConcurrently")
-
-    let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger
-    DiagnosticsThreadStatics.DiagnosticsLogger <- newLogger
-
-    { new IDisposable with
-        member _.Dispose() =
-            newLogger.CommitDelayedDiagnostics oldLogger
-            DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger
-    }
-
 let SetThreadBuildPhaseNoUnwind (phase: BuildPhase) =
-    DiagnosticsThreadStatics.BuildPhase <- phase
+    DiagnosticsAsyncState.BuildPhase <- phase
 
 let SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger =
-    DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger
+    DiagnosticsAsyncState.DiagnosticsLogger <- diagnosticsLogger
 
 /// This represents the thread-local state established as each task function runs as part of the build.
 ///
@@ -577,30 +562,43 @@ type CompilationGlobalsScope(diagnosticsLogger: DiagnosticsLogger, buildPhase: B
             unwindBP.Dispose()
             unwindEL.Dispose()
 
+type CaptureDiagnosticsConcurrently(target) =
+    let loggers = System.Collections.Concurrent.ConcurrentQueue()
+
+    member _.LoggerForTask: DiagnosticsLogger =
+        let logger = CapturingDiagnosticsLogger("One of parallel computations")
+        loggers.Enqueue logger
+        logger
+
+    interface IDisposable with
+        member _.Dispose() =
+            for logger in loggers do
+                logger.CommitDelayedDiagnostics target
+
 // Global functions are still used by parser and TAST ops.
 
 /// Raises an exception with error recovery and returns unit.
 let errorR exn =
-    DiagnosticsThreadStatics.DiagnosticsLogger.ErrorR exn
+    DiagnosticsAsyncState.DiagnosticsLogger.ErrorR exn
 
 /// Raises a warning with error recovery and returns unit.
 let warning exn =
-    DiagnosticsThreadStatics.DiagnosticsLogger.Warning exn
+    DiagnosticsAsyncState.DiagnosticsLogger.Warning exn
 
 /// Raises a warning with error recovery and returns unit.
 let informationalWarning exn =
-    DiagnosticsThreadStatics.DiagnosticsLogger.InformationalWarning exn
+    DiagnosticsAsyncState.DiagnosticsLogger.InformationalWarning exn
 
 /// Raises a special exception and returns 'T - can be caught later at an errorRecovery point.
 let error exn =
-    DiagnosticsThreadStatics.DiagnosticsLogger.Error exn
+    DiagnosticsAsyncState.DiagnosticsLogger.Error exn
 
 /// Simulates an error. For test purposes only.
 let simulateError (diagnostic: PhasedDiagnostic) =
-    DiagnosticsThreadStatics.DiagnosticsLogger.SimulateError diagnostic
+    DiagnosticsAsyncState.DiagnosticsLogger.SimulateError diagnostic
 
 let diagnosticSink (diagnostic, severity) =
-    DiagnosticsThreadStatics.DiagnosticsLogger.DiagnosticSink(diagnostic, severity)
+    DiagnosticsAsyncState.DiagnosticsLogger.DiagnosticSink(diagnostic, severity)
 
 let errorSink diagnostic =
     diagnosticSink (diagnostic, FSharpDiagnosticSeverity.Error)
@@ -609,13 +607,13 @@ let warnSink diagnostic =
     diagnosticSink (diagnostic, FSharpDiagnosticSeverity.Warning)
 
 let errorRecovery exn m =
-    DiagnosticsThreadStatics.DiagnosticsLogger.ErrorRecovery exn m
+    DiagnosticsAsyncState.DiagnosticsLogger.ErrorRecovery exn m
 
 let stopProcessingRecovery exn m =
-    DiagnosticsThreadStatics.DiagnosticsLogger.StopProcessingRecovery exn m
+    DiagnosticsAsyncState.DiagnosticsLogger.StopProcessingRecovery exn m
 
 let errorRecoveryNoRange exn =
-    DiagnosticsThreadStatics.DiagnosticsLogger.ErrorRecoveryNoRange exn
+    DiagnosticsAsyncState.DiagnosticsLogger.ErrorRecoveryNoRange exn
 
 let deprecatedWithError s m = errorR (Deprecated(s, m))
 
@@ -634,7 +632,7 @@ let mlCompatError s m =
 
 [<DebuggerStepThrough>]
 let suppressErrorReporting f =
-    let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
+    let diagnosticsLogger = DiagnosticsAsyncState.DiagnosticsLogger
 
     try
         let diagnosticsLogger =

src/Compiler/Facilities/DiagnosticsLogger.fsi

@@ -243,7 +243,7 @@ type ConcurrentCapturingDiagnosticsLogger =
 
 /// Thread statics for the installed diagnostic logger
 [<Class>]
-type DiagnosticsThreadStatics =
+type DiagnosticsAsyncState =
 
     static member BuildPhase: BuildPhase with get, set
 
@@ -295,12 +295,17 @@ val UseTransformedDiagnosticsLogger: transformer: (DiagnosticsLogger -> #Diagnos
 
 val UseDiagnosticsLogger: newLogger: DiagnosticsLogger -> IDisposable
 
-val CaptureDiagnosticsConcurrently: unit -> IDisposable
-
 val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit
 
 val SetThreadDiagnosticsLoggerNoUnwind: diagnosticsLogger: DiagnosticsLogger -> unit
 
+type CaptureDiagnosticsConcurrently =
+    new: target: DiagnosticsLogger -> CaptureDiagnosticsConcurrently
+
+    member LoggerForTask: DiagnosticsLogger
+
+    interface IDisposable
+
 /// Reports an error diagnostic and continues
 val errorR: exn: exn -> unit
 

tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs

@@ -441,13 +441,13 @@ let ``Preserve thread static diagnostics`` () =
     let job1 (input: string) = async {
         let! _ = Async.Sleep (rng.Next(1, 30))
         let ex = DummyException("job1 error")
-        DiagnosticsThreadStatics.DiagnosticsLogger.ErrorR(ex)
+        DiagnosticsAsyncState.DiagnosticsLogger.ErrorR(ex)
         return Ok input
     }
 
     let job2 (input: int) = async {
 
-        DiagnosticsThreadStatics.DiagnosticsLogger.Warning(DummyException("job2 error 1"))
+        DiagnosticsAsyncState.DiagnosticsLogger.Warning(DummyException("job2 error 1"))
 
         let! _ = Async.Sleep (rng.Next(1, 30))
 
@@ -458,7 +458,7 @@ let ``Preserve thread static diagnostics`` () =
 
         let! result = job1Cache.Get(key, job1 "${input}" )
 
-        DiagnosticsThreadStatics.DiagnosticsLogger.Warning(DummyException("job2 error 2"))
+        DiagnosticsAsyncState.DiagnosticsLogger.Warning(DummyException("job2 error 2"))
 
         return input, result
 
@@ -473,7 +473,7 @@ let ``Preserve thread static diagnostics`` () =
 
                 use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Optimize)
 
-                DiagnosticsThreadStatics.DiagnosticsLogger.Warning(DummyException("task error"))
+                DiagnosticsAsyncState.DiagnosticsLogger.Warning(DummyException("task error"))
 
 
                 let key = { new ICacheKey<_, _> with
@@ -514,7 +514,7 @@ let ``Preserve thread static diagnostics already completed job`` () =
 
     let job (input: string) = async {
         let ex = DummyException($"job {input} error")
-        DiagnosticsThreadStatics.DiagnosticsLogger.ErrorR(ex)
+        DiagnosticsAsyncState.DiagnosticsLogger.ErrorR(ex)
         return Ok input
     }
 
@@ -548,7 +548,7 @@ let ``We get diagnostics from the job that failed`` () =
     let job (input: int) = async {
         let ex = DummyException($"job {input} error")
         do! Async.Sleep 100
-        DiagnosticsThreadStatics.DiagnosticsLogger.Error(ex)
+        DiagnosticsAsyncState.DiagnosticsLogger.Error(ex)
         return 5
     }
 

tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs

@@ -231,14 +231,14 @@ module BuildGraphTests =
 
         let job phase _ = async {
             do! random 10 |> Async.Sleep 
-            Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase)
+            Assert.Equal(phase, DiagnosticsAsyncState.BuildPhase)
         }
 
         let work (phase: BuildPhase) =
             async {
                 use _ = new CompilationGlobalsScope(DiscardErrorsLogger, phase)
                 let! _ = Seq.init 8 (job phase) |> Async.Parallel
-                Assert.Equal(phase, DiagnosticsThreadStatics.BuildPhase)
+                Assert.Equal(phase, DiagnosticsAsyncState.BuildPhase)
             }
 
         let phases = [|

tests/FSharp.Compiler.UnitTests/HashIfExpression.fs

@@ -64,7 +64,7 @@ type public HashIfExpression() =
         let startPos = Position.Empty
         let args = mkLexargs (defines, indentationSyntaxStatus, resourceManager, [], diagnosticsLogger, PathMap.empty, applyLineDirectives)
 
-        DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLogger
+        DiagnosticsAsyncState.DiagnosticsLogger <- diagnosticsLogger
 
         let parser (s : string) =
             let lexbuf = LexBuffer<char>.FromChars (true, LanguageVersion.Default, None, s.ToCharArray ())
@@ -77,11 +77,11 @@ type public HashIfExpression() =
         errors, warnings, parser
 
     do // Setup
-        DiagnosticsThreadStatics.BuildPhase <- BuildPhase.Compile
+        DiagnosticsAsyncState.BuildPhase <- BuildPhase.Compile
     interface IDisposable with // Teardown
         member _.Dispose() =
-            DiagnosticsThreadStatics.BuildPhase <- BuildPhase.DefaultPhase
-            DiagnosticsThreadStatics.DiagnosticsLogger <- DiagnosticsThreadStatics.DiagnosticsLogger
+            DiagnosticsAsyncState.BuildPhase <- BuildPhase.DefaultPhase
+            DiagnosticsAsyncState.DiagnosticsLogger <- DiagnosticsAsyncState.DiagnosticsLogger
 
     [<Fact>]
     member _.PositiveParserTestCases()=