Fix #7564 (#7596)

* Add a bind to Parallel test to force async continuations

* Fixing Parallel and more tests

* Use trampoline holder directly

* Split race test to check with and without max degree

* Fix RaceBetweenCancellationAndError tests (use an async that errors)

Author: Frassle

src/fsharp/FSharp.Core/async.fs

@@ -1250,31 +1250,28 @@ namespace Microsoft.FSharp.Control
                                 |> unfake)
                     | Some maxDegreeOfParallelism ->
                         let mutable i = -1
-                        let worker = MakeAsync (fun _ ->
-                            while i < tasks.Length do
+                        let rec worker (trampolineHolder : TrampolineHolder) =
+                            if i < tasks.Length then
                                 let j = Interlocked.Increment &i
                                 if j < tasks.Length then
-                                    let trampolineHolder = new TrampolineHolder()
-                                    trampolineHolder.ExecuteWithTrampoline (fun () ->
-                                        let ctxt =
+                                    if innerCTS.Token.IsCancellationRequested then
+                                        let cexn = new OperationCanceledException (innerCTS.Token)
+                                        recordFailure (Choice2Of2 cexn) |> unfake
+                                        worker trampolineHolder |> unfake
+                                    else
+                                        let taskCtxt =
                                             AsyncActivation.Create
                                                 innerCTS.Token
                                                 trampolineHolder
-                                                (fun res -> recordSuccess j res)
-                                                (fun edi -> recordFailure (Choice1Of2 edi))
-                                                (fun cexn -> recordFailure (Choice2Of2 cexn))
-                                        tasks.[j].Invoke ctxt
-                                    )
-                                    |> unfake
+                                                (fun res -> recordSuccess j res |> unfake; worker trampolineHolder)
+                                                (fun edi -> recordFailure (Choice1Of2 edi) |> unfake; worker trampolineHolder)
+                                                (fun cexn -> recordFailure (Choice2Of2 cexn) |> unfake; worker trampolineHolder)
+                                        tasks.[j].Invoke taskCtxt |> unfake
                             fake()
-                        )
                         for x = 1 to maxDegreeOfParallelism do
-                            QueueAsync
-                                innerCTS.Token
-                                (fun _ -> fake())
-                                (fun edi -> recordFailure (Choice1Of2 edi))
-                                (fun cexn -> recordFailure (Choice2Of2 cexn))
-                                worker
+                            let trampolineHolder = new TrampolineHolder()
+                            trampolineHolder.QueueWorkItemWithTrampoline (fun () ->
+                                worker trampolineHolder)
                             |> unfake
 
                     fake()))

tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs

@@ -630,6 +630,7 @@ type AsyncModule() =
     member this.``Parallel with maxDegreeOfParallelism`` () =
         let mutable i = 1
         let action j = async {
+            do! Async.Sleep 1
             Assert.AreEqual(j, i)
             i <- i + 1
         }
@@ -662,14 +663,17 @@ type AsyncModule() =
             Assert.AreEqual("maxDegreeOfParallelism", exc.ParamName)
             Assert.True(exc.Message.Contains("maxDegreeOfParallelism must be positive, was -1"))
 
-//  This has been failing very regularly on LINUX --- issue   :  https://github.com/dotnet/fsharp/issues/7112
-#if !TESTING_ON_LINUX
     [<Test>]
-    member this.``RaceBetweenCancellationAndError.Parallel``() =
-        [| for i in 1 .. 1000 -> async { return i } |]
+    member this.``RaceBetweenCancellationAndError.Parallel(maxDegreeOfParallelism)``() =
+        [| for i in 1 .. 1000 -> async { failwith "boom" } |]
         |> fun cs -> Async.Parallel(cs, 1)
+        |> testErrorAndCancelRace "RaceBetweenCancellationAndError.Parallel(maxDegreeOfParallelism)"
+
+    [<Test>]
+    member this.``RaceBetweenCancellationAndError.Parallel``() =
+        [| for i in 1 .. 1000 -> async { failwith "boom" } |]
+        |> fun cs -> Async.Parallel(cs)
         |> testErrorAndCancelRace "RaceBetweenCancellationAndError.Parallel"
-#endif
 
     [<Test>]
     member this.``error on one workflow should cancel all others with maxDegreeOfParallelism``() =
@@ -679,13 +683,11 @@ type AsyncModule() =
                 let job i = async {
                     if i = 55 then failwith "boom"
                     else
-                        do! Async.Sleep 1000
                         incr counter
                 }
 
-                let! _ = Async.Parallel ([ for i in 1 .. 100 -> job i ], 2) |> Async.Catch
-                do! Async.Sleep 5000
+                let! _ = Async.Parallel ([ for i in 1 .. 100 -> job i ], 1) |> Async.Catch
                 return !counter
             } |> Async.RunSynchronously
 
-        Assert.AreEqual(0, counter)
+        Assert.AreEqual(54, counter)