Graph-based type-checking: fix when node processing throws

src/Compiler/Driver/GraphChecking/GraphProcessing.fs

@@ -91,9 +91,10 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
     /// Only the first exception encountered is stored - this can cause non-deterministic errors if more than one item fails.
     let raiseExn, getExn =
         let mutable exn: ('Item * System.Exception) option = None
+        let lockObj = obj ()
         // Only set the exception if it hasn't been set already
         let setExn newExn =
-            lock exn (fun () ->
+            lock lockObj (fun () ->
                 match exn with
                 | Some _ -> ()
                 | None -> exn <- newExn

tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj

@@ -207,6 +207,7 @@
     <Content Include="TypeChecks\Graph\scrape.fsx" CopyToOutputDirectory="Never" />
     <Compile Include="TypeChecks\Graph\CompilationFromCmdlineArgsTests.fs" />
     <Compile Include="TypeChecks\Graph\TypedTreeGraph.fs" />
+    <Compile Include="TypeChecks\Graph\GraphProcessingTests.fs" />
     <Compile Include="TypeChecks\TyparNameTests.fs" />
     <Compile Include="CompilerOptions\fsc\checked\checked.fs" />
     <Compile Include="CompilerOptions\fsc\cliversion.fs" />

tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs

@@ -0,0 +1,23 @@
+module TypeChecks.GraphProcessingTests
+
+open System.Threading
+open FSharp.Compiler.GraphChecking.GraphProcessing
+open NUnit.Framework
+
+[<Test>]
+let ``When processing a node throws an exception, an exception is raised with the original exception included`` () =
+    let graph = [1, [|2|]; 2, [||]] |> readOnlyDict
+    let work (_processor : int -> ProcessedNode<int, string>) (_node : NodeInfo<int>) : string = failwith "Work exception"
+
+    let exn =
+        Assert.Throws<System.Exception>(
+            fun () ->
+                processGraph
+                    graph
+                    work
+                    CancellationToken.None
+                |> ignore
+        )
+    Assert.That(exn.Message, Is.EqualTo("Encountered exception when processing item '2'"))
+    Assert.That(exn.InnerException, Is.Not.Null)
+    Assert.That(exn.InnerException.Message, Is.EqualTo("Work exception"))