Fix Async.Parallel stack overflow on cancellation of ~2000 uncompleted (#13186)

* Fix Async.Parallel stack overflow on cancellation of ~2000 uncompleted computations

* Update AsyncModule.fs

* Update AsyncModule.fs

Author: dsyme

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()))

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)
+
+    [<Fact>]
+    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