From 34e13b53560269132481517ae14afd614c9f7e22 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 23 May 2022 17:53:37 +0100 Subject: [PATCH 1/3] Fix Async.Parallel stack overflow on cancellation of ~2000 uncompleted computations --- src/FSharp.Core/async.fs | 12 ++++++------ .../Microsoft.FSharp.Control/AsyncModule.fs | 12 ++++++++++++ 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/src/FSharp.Core/async.fs b/src/FSharp.Core/async.fs index 73a229670b3..0b64a6450d1 100644 --- a/src/FSharp.Core/async.fs +++ b/src/FSharp.Core/async.fs @@ -1470,21 +1470,21 @@ type Async = if innerCTS.Token.IsCancellationRequested then let cexn = OperationCanceledException (innerCTS.Token) recordFailure (Choice2Of2 cexn) |> unfake - worker trampolineHolder |> unfake + worker trampolineHolder else let taskCtxt = AsyncActivation.Create innerCTS.Token trampolineHolder - (fun res -> recordSuccess j res |> unfake; worker trampolineHolder) - (fun edi -> recordFailure (Choice1Of2 edi) |> unfake; worker trampolineHolder) - (fun cexn -> recordFailure (Choice2Of2 cexn) |> unfake; worker trampolineHolder) + (fun res -> recordSuccess j res |> unfake; worker trampolineHolder |> fake) + (fun edi -> recordFailure (Choice1Of2 edi) |> unfake; worker trampolineHolder |> fake) + (fun cexn -> recordFailure (Choice2Of2 cexn) |> unfake; worker trampolineHolder |> fake) computations.[j].Invoke taskCtxt |> unfake - fake() + for x = 1 to maxDegreeOfParallelism do let trampolineHolder = TrampolineHolder() trampolineHolder.QueueWorkItemWithTrampoline (fun () -> - worker trampolineHolder) + worker trampolineHolder |> fake) |> unfake fake())) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 103b636c127..adcb9e2e46b 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -764,3 +764,15 @@ type AsyncModule() = lock gate <| fun () -> printfn "Unhandled exception: %s" exn.Message lock gate <| fun () -> printfn "Semaphore count available: %i" semaphore.CurrentCount Assert.AreEqual(acquiredCount, releaseCount) + + [] + member _.``Async.Parallel blows stack when cancelling many`` () = + let gen (i : int) = async { + if i <> 0 then do! Async.Sleep i + else return failwith (string i) } + let count = 1800 + let comps = Seq.init count gen + let result = Async.Parallel(comps, 16) |> Async.Catch |> Async.RunSynchronously + match result with + | Choice2Of2 e -> () + | x -> failwithf "unexpected %A" x From 0aadd7361d10705f4b4386b1dd376fb0400ae7c7 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 23 May 2022 19:39:32 +0100 Subject: [PATCH 2/3] Update AsyncModule.fs --- .../FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index adcb9e2e46b..b85e5cf92a7 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -770,7 +770,7 @@ type AsyncModule() = let gen (i : int) = async { if i <> 0 then do! Async.Sleep i else return failwith (string i) } - let count = 1800 + let count = 3600 let comps = Seq.init count gen let result = Async.Parallel(comps, 16) |> Async.Catch |> Async.RunSynchronously match result with From d9935fab5869b87d2225e9daf3dd2b0945f93b1a Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 23 May 2022 19:42:42 +0100 Subject: [PATCH 3/3] Update AsyncModule.fs --- .../FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index b85e5cf92a7..2edf022ac75 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -769,10 +769,10 @@ type AsyncModule() = member _.``Async.Parallel blows stack when cancelling many`` () = let gen (i : int) = async { if i <> 0 then do! Async.Sleep i - else return failwith (string i) } + else return failwith "OK"} let count = 3600 let comps = Seq.init count gen let result = Async.Parallel(comps, 16) |> Async.Catch |> Async.RunSynchronously match result with - | Choice2Of2 e -> () + | Choice2Of2 e -> Assert.AreEqual("OK", e.Message) | x -> failwithf "unexpected %A" x