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..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 @@ -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 "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 -> Assert.AreEqual("OK", e.Message) + | x -> failwithf "unexpected %A" x