Fix MultipleDiagnosticsLoggers.Parallel deadlock

src/Compiler/Facilities/DiagnosticsLogger.fs

@@ -949,9 +949,19 @@ module MultipleDiagnosticsLoggers =
             try
                 // We want to restore the current diagnostics context when finished.
                 use _ = new CompilationGlobalsScope()
-                return! Async.Parallel computationsWithLoggers
+                let! results = Async.Parallel computationsWithLoggers
+                do! replayDiagnostics |> Async.AwaitTask
+                return results
             finally
-                replayDiagnostics.Wait()
+                // When any of the computation throws, Async.Parallel may not start some remaining computations at all.
+                // We set dummy results for them to allow the task to finish and to not lose any already emitted diagnostics.
+                if not replayDiagnostics.IsCompleted then
+                    let emptyLogger = CapturingDiagnosticsLogger("empty")
+
+                    for tcs in diagnosticsReady do
+                        tcs.TrySetResult(emptyLogger) |> ignore
+
+                    replayDiagnostics.Wait()
         }
 
     let Sequential computations =

tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs

@@ -374,7 +374,32 @@ module BuildGraphTests =
 
         errorCountShouldBe 600
 
+    [<Fact>]
+    let ``MultipleDiagnosticsLoggers.Parallel finishes when any computation throws`` () =
+
+        let mutable count = 0
+        use _ = UseDiagnosticsLogger (CapturingDiagnosticsLogger "test logger")
+
+        let tasks = [
+            async { failwith "computation failed" }
+
+            for i in 1 .. 300 do
+                async {
+                    Interlocked.Increment(&count) |> ignore
+                    errorR (ExampleException $"{i}")
+                }
+        ]
+
+        let run =
+            tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.StartAsTask
+
+        Assert.True(
+            run.Wait(1000),
+            "MultipleDiagnosticsLoggers.Parallel did not finish."
+        )
 
+        // Diagnostics from all started tasks should be collected despite the exception.
+        errorCountShouldBe count
 
 
     [<Fact>]