From 0f161dcbdc7c62250fbfc18d252704e4b65a2745 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Fri, 23 Jun 2023 17:45:45 +0100 Subject: [PATCH 1/4] Graph-based type-checking: fix when node processing throws --- .../Driver/GraphChecking/GraphProcessing.fs | 5 ++-- .../FSharp.Compiler.ComponentTests.fsproj | 1 + .../TypeChecks/Graph/GraphProcessingTests.fs | 25 +++++++++++++++++++ 3 files changed, 29 insertions(+), 2 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 332ed2a00e..690d0d10ed 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/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 = 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 @@ -113,7 +114,7 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> let! res = async { processNode node } |> Async.Catch match res with - | Choice1Of2 () -> () + | Choice1Of2 () -> raiseExn (Some(node.Info.Item, exn "foo")) | Choice2Of2 ex -> raiseExn (Some(node.Info.Item, ex)) }, cts.Token diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 0145bcfa60..c99458dabb 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -207,6 +207,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs new file mode 100644 index 0000000000..cc0ea7e07a --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs @@ -0,0 +1,25 @@ +module TypeChecks.GraphProcessingTests + +open System.Threading +open FSharp.Compiler.GraphChecking.GraphProcessing +open NUnit.Framework + +type Node = int + +[] +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) (_node : NodeInfo) : string = failwith "Work exception" + + let exn = + Assert.Throws( + 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")) From 03917acf1015ebf9b4ee3670912f76a1c2034ca3 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Fri, 23 Jun 2023 17:52:19 +0100 Subject: [PATCH 2/4] Reformat --- src/Compiler/Driver/GraphChecking/GraphProcessing.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 690d0d10ed..67d9b975e4 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -91,7 +91,7 @@ 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 = obj() + let lockObj = obj () // Only set the exception if it hasn't been set already let setExn newExn = lock lockObj (fun () -> From a0321e8bd127ddaab6b09329ce6d3fbcde890db6 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Fri, 23 Jun 2023 17:52:57 +0100 Subject: [PATCH 3/4] Revert test change --- src/Compiler/Driver/GraphChecking/GraphProcessing.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 67d9b975e4..2cadaf25ac 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -114,7 +114,7 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison> let! res = async { processNode node } |> Async.Catch match res with - | Choice1Of2 () -> raiseExn (Some(node.Info.Item, exn "foo")) + | Choice1Of2 () -> () | Choice2Of2 ex -> raiseExn (Some(node.Info.Item, ex)) }, cts.Token From 9be3c81c1449078d81501fd94c352d173a673ac6 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Fri, 23 Jun 2023 17:53:57 +0100 Subject: [PATCH 4/4] Remove code --- .../TypeChecks/Graph/GraphProcessingTests.fs | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs index cc0ea7e07a..3e5483b0a7 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/GraphProcessingTests.fs @@ -4,8 +4,6 @@ open System.Threading open FSharp.Compiler.GraphChecking.GraphProcessing open NUnit.Framework -type Node = int - [] let ``When processing a node throws an exception, an exception is raised with the original exception included`` () = let graph = [1, [|2|]; 2, [||]] |> readOnlyDict