From 0858b0b6b982a12f9edb430ca8d630e4562ce599 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 12:43:08 +0200 Subject: [PATCH 01/13] named test runs in ci --- azure-pipelines-PR.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/azure-pipelines-PR.yml b/azure-pipelines-PR.yml index 0c7bc9b5a17..9a5c59441e2 100644 --- a/azure-pipelines-PR.yml +++ b/azure-pipelines-PR.yml @@ -488,6 +488,8 @@ stages: displayName: Publish Test Results inputs: testResultsFormat: 'XUnit' + testRunTitle: WindowsCompressedMetadata $(_testKind) + mergeTestResults: true testResultsFiles: '*.xml' searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_configuration)' continueOnError: true @@ -558,7 +560,9 @@ stages: displayName: Publish Test Results inputs: testResultsFormat: 'XUnit' + testRunTitle: Linux testResultsFiles: '*.xml' + mergeTestResults: true searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() @@ -602,6 +606,8 @@ stages: inputs: testResultsFormat: 'XUnit' testResultsFiles: '*.xml' + testRunTitle: MacOS + mergeTestResults: true searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() From 9f86432e1b07ffb6028c251ff44ae9471bf66432 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 12:43:43 +0200 Subject: [PATCH 02/13] unskip some old tests that actually do work --- .../Compiler/Libraries/Core/Async/AsyncTests.fs | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs b/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs index 708e7e58e2e..3b83b97db7a 100644 --- a/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs +++ b/tests/fsharp/Compiler/Libraries/Core/Async/AsyncTests.fs @@ -8,7 +8,7 @@ open FSharp.Test module AsyncTests = // Regression for FSHARP1.0:5969 // Async.StartChild: error when wait async is executed more than once - [] + [] let ``Execute Async multiple times``() = CompilerAssert.CompileExeAndRun """ @@ -24,13 +24,12 @@ let a = async { return result } |> Async.RunSynchronously -exit 0 """ // Regression for FSHARP1.0:5970 // Async.StartChild: race in implementation of ResultCell in FSharp.Core - [] + [] let ``Joining StartChild``() = CompilerAssert.CompileExeAndRun """ @@ -54,12 +53,10 @@ let r = with _ -> (0,0) -exit 0 - """ // Regression test for FSHARP1.0:6086 - [] + [] let ``Mailbox Async dot not StackOverflow``() = CompilerAssert.CompileExeAndRun """ @@ -128,12 +125,11 @@ for meet in meets do printfn "%d" meet printfn "Total: %d in %O" (Seq.sum meets) (watch.Elapsed) -exit 0 """ // Regression for FSHARP1.0:5971 - [] + [] let ``StartChild do not throw ObjectDisposedException``() = CompilerAssert.CompileExeAndRun """ @@ -142,10 +138,9 @@ module M let b = async {return 5} |> Async.StartChild printfn "%A" (b |> Async.RunSynchronously |> Async.RunSynchronously) -exit 0 """ - [] + [] let ``StartChild test Trampoline HijackLimit``() = CompilerAssert.CompileExeAndRun """ @@ -164,5 +159,4 @@ let r = () } |> Async.RunSynchronously -exit 0 """ From 94bc8c131a5425670df134230c49b6c494f1c2fb Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 12:46:20 +0200 Subject: [PATCH 03/13] use some tasks in core\controlMailbox --- tests/fsharp/core/controlMailbox/test.fsx | 236 ++++++++++------------ 1 file changed, 102 insertions(+), 134 deletions(-) diff --git a/tests/fsharp/core/controlMailbox/test.fsx b/tests/fsharp/core/controlMailbox/test.fsx index 98d6a7d2f31..a29c16a85bf 100644 --- a/tests/fsharp/core/controlMailbox/test.fsx +++ b/tests/fsharp/core/controlMailbox/test.fsx @@ -6,9 +6,7 @@ module Core_controlMailBox #nowarn "40" // recursive references -#if NETCOREAPP open System.Threading.Tasks -#endif let biggerThanTrampoliningLimit = 10000 @@ -49,22 +47,27 @@ let checkQuiet s x1 x2 = (test s false; log (sprintf "expected: %A, got %A" x2 x1)) -let check s x1 x2 = +let check s x1 x2 = if x1 = x2 then test s true else (test s false; log (sprintf "expected: %A, got %A" x2 x1)) +let checkAsync s (x1: Task<_>) x2 = check s x1.Result x2 + open Microsoft.FSharp.Control -open Microsoft.FSharp.Control.WebExtensions module MailboxProcessorBasicTests = + let test() = check "c32398u6: MailboxProcessor null" - (let mb1 = new MailboxProcessor(fun inbox -> async { return () }) - mb1.Start(); - 100) - 100 + ( + let mb1 = new MailboxProcessor(fun inbox -> async { return () }) + mb1.Start() + 100 + ) + + 100 check "c32398u7: MailboxProcessor Receive/PostAndReply" @@ -197,9 +200,10 @@ module MailboxProcessorBasicTests = 200 for n in [0; 1; 100; 1000; 100000 ] do - check + checkAsync (sprintf "c32398u: MailboxProcessor Post/Receive, n=%d" n) - (let received = ref 0 + (task { + let received = ref 0 let mb1 = new MailboxProcessor(fun inbox -> async { for i in 0 .. n-1 do let! _ = inbox.Receive() @@ -208,84 +212,66 @@ module MailboxProcessorBasicTests = for i in 0 .. n-1 do mb1.Post(i) while !received < n do - if !received % 100 = 0 then - printfn "received = %d" !received -#if NETCOREAPP - Task.Delay(1).Wait() -#else - System.Threading.Thread.Sleep(1) -#endif - !received) + do! Task.Yield() + return !received}) n for timeout in [0; 10] do for n in [0; 1; 100] do - check + checkAsync (sprintf "c32398u: MailboxProcessor Post/TryReceive, n=%d, timeout=%d" n timeout) - (let received = ref 0 + (task { + let received = ref 0 let mb1 = new MailboxProcessor(fun inbox -> async { while !received < n do - let! msgOpt = inbox.TryReceive(timeout=timeout) - match msgOpt with - | None -> - do if !received % 100 = 0 then - printfn "timeout!, received = %d" !received - | Some _ -> do incr received }) + match! inbox.TryReceive(timeout=timeout) with + | Some _ -> incr received + | _ -> () + }) + + mb1.Post(0) + mb1.Start(); for i in 0 .. n-1 do -#if NETCOREAPP - Task.Delay(1).Wait(); -#else - System.Threading.Thread.Sleep(1) -#endif mb1.Post(i) + do! Task.Yield() while !received < n do - if !received % 100 = 0 then - printfn "main thread: received = %d" !received -#if NETCOREAPP - Task.Delay(1).Wait(); -#else - System.Threading.Thread.Sleep(1) -#endif - !received) + do! Task.Yield() + return !received}) n for i in 1..10 do for sleep in [0;1;10] do for timeout in [10;1;0] do - check + checkAsync (sprintf "cf72361: MailboxProcessor TryScan w/timeout=%d sleep=%d iteration=%d" timeout sleep i) - (let timedOut = ref None - let mb = new MailboxProcessor(fun inbox -> - async { - let result = ref None - let count = ref 0 - while (!result).IsNone && !count < 5 do - let! curResult = inbox.TryScan((fun i -> if i >= 0 then async { return i } |> Some else None), timeout=timeout) - result := curResult - count := !count + 1 - match !result with - | None -> - timedOut := Some true - | Some i -> - timedOut := Some false - }) + ( + let timedOut = TaskCompletionSource<_>() + use mb = new MailboxProcessor(fun inbox -> + async { + let! result = inbox.TryScan((fun i -> if i >= 0 then async { return i } |> Some else None), timeout=timeout) + timedOut.SetResult result.IsNone + } + ) mb.Start() - let w = System.Diagnostics.Stopwatch() - w.Start() - while w.ElapsedMilliseconds < 1000L && (!timedOut).IsNone do - mb.Post(-1) -#if NETCOREAPP - Task.Delay(1).Wait(); -#else - System.Threading.Thread.Sleep(1) -#endif - mb.Post(0) - !timedOut) - (Some true) - - check "cf72361: MailboxProcessor TryScan wo/timeout" - (let timedOut = ref None + + let _ = task { + do! Task.Delay 1000 + timedOut.TrySetResult false |> ignore + } + + task { + while not timedOut.Task.IsCompleted do + do! Task.Delay sleep + mb.Post(-1) + return! timedOut.Task + } + ) + (true) + + checkAsync "cf72361: MailboxProcessor TryScan wo/timeout" + (task { + let timedOut = ref None let mb = new MailboxProcessor(fun inbox -> async { let! result = inbox.TryScan((fun i -> if i then async { return () } |> Some else None)) @@ -298,65 +284,58 @@ module MailboxProcessorBasicTests = w.Start() while w.ElapsedMilliseconds < 100L do mb.Post(false) -#if NETCOREAPP - Task.Delay(0).Wait(); -#else - System.Threading.Thread.Sleep(0) -#endif + do! Task.Yield() let r = !timedOut mb.Post(true) - r) + return r}) None module MailboxProcessorErrorEventTests = exception Err of int let test() = // Make sure the event doesn't get raised if no error - check + checkAsync "c32398u9330: MailboxProcessor Error (0)" - (let mb1 = new MailboxProcessor(fun inbox -> async { return () }) - let res = ref 100 - mb1.Error.Add(fun _ -> res := 0) + (task { + let mb1 = new MailboxProcessor(fun inbox -> async { return () }) + mb1.Error.Add(fun _ -> failwith "unexpected error event") mb1.Start(); -#if NETCOREAPP - Task.Delay(200).Wait(); -#else - System.Threading.Thread.Sleep(200) -#endif - !res) + do! Task.Delay(200) + return 100}) 100 // Make sure the event does get raised if error - check + check "c32398u9331: MailboxProcessor Error (1)" (let mb1 = new MailboxProcessor(fun inbox -> async { failwith "fail" }) - let res = ref 0 - mb1.Error.Add(fun _ -> res := 100) + use res = new System.Threading.ManualResetEventSlim(false) + mb1.Error.Add(fun _ -> res.Set()) mb1.Start(); -#if NETCOREAPP - Task.Delay(200).Wait(); -#else - System.Threading.Thread.Sleep(200) -#endif - !res) - 100 + res.Wait() + true) + true // Make sure the event does get raised after message receive - check + checkAsync "c32398u9332: MailboxProcessor Error (2)" - (let mb1 = new MailboxProcessor(fun inbox -> - async { let! msg = inbox.Receive() - raise (Err msg) }) - let res = ref 0 - mb1.Error.Add(function Err n -> res := n | _ -> check "rwe90r - unexpected error" 0 1) - mb1.Start(); - mb1.Post 100 -#if NETCOREAPP - Task.Delay(200).Wait(); -#else - System.Threading.Thread.Sleep(200) -#endif - !res) + ( + let errorNumber = TaskCompletionSource<_>() + + let mb1 = new MailboxProcessor( fun inbox -> async { + let! msg = inbox.Receive() + raise (Err msg) + }) + + mb1.Error.Add(function + | Err n -> errorNumber.SetResult n + | _ -> + check "rwe90r - unexpected error" 0 1 ) + + mb1.Start(); + mb1.Post 100 + + errorNumber.Task + ) 100 type msg = Increment of int | Fetch of AsyncReplyChannel | Reset @@ -472,13 +451,10 @@ let test7() = let timeoutboxes str = new MailboxProcessor<'b>(fun inbox -> - async { for i in 1 .. 10 do -#if NETCOREAPP - Task.Delay(200).Wait() -#else - do System.Threading.Thread.Sleep 200 -#endif - }) + async { + for i in 1 .. 10 do + do! Async.Sleep 200 + }) // Timeout let timeout_tpar() = @@ -553,17 +529,9 @@ let timeout_para_def() = test "default timeout & PostAndAsyncReply" false with _ -> test "default timeout & PostAndAsyncReply" true -// Useful class: put "checkpoints" in the code. -// Check they are called in the right order. -type Path(str) = - let mutable current = 0 - member p.Check n = check (str + " #" + string (current+1)) n (current+1) - current <- n - - - module LotsOfMessages = let test () = + task { let N = 200000 let count = ref N @@ -586,12 +554,9 @@ module LotsOfMessages = check "celrv09ervkn" (queueLength >= logger.CurrentQueueLength) true queueLength <- logger.CurrentQueueLength -#if NETCOREAPP - Task.Delay(10).Wait() -#else - System.Threading.Thread.Sleep(10) -#endif + do! Task.Delay(10) check "celrv09ervknf3ew" logger.CurrentQueueLength 0 + } let RunAll() = MailboxProcessorBasicTests.test() @@ -608,11 +573,11 @@ let RunAll() = timeout_tpar_def() // ToDo: 7/31/2008: Disabled because of probable timing issue. QA needs to re-enable post-CTP. // Tracked by bug FSharp 1.0:2891 - //test15() + // test15() // ToDo: 7/31/2008: Disabled because of probable timing issue. QA needs to re-enable post-CTP. // Tracked by bug FSharp 1.0:2891 - //test15b() - LotsOfMessages.test() + // test15b() + LotsOfMessages.test().Wait() #if TESTS_AS_APP let RUN() = RunAll(); failures @@ -621,6 +586,9 @@ RunAll() let aa = if not failures.IsEmpty then stdout.WriteLine "Test Failed" + stdout.WriteLine() + stdout.WriteLine "failures:" + failures |> List.iter stdout.WriteLine exit 1 else stdout.WriteLine "Test Passed" From 03c789da06f4a21fb472b602303c9df483307fc0 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 12:47:03 +0200 Subject: [PATCH 04/13] remove timeouts from AsyncMemoize tests --- .../CompilerService/AsyncMemoize.fs | 369 ++++++++---------- 1 file changed, 171 insertions(+), 198 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 72dd62e397c..802f07012de 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -2,164 +2,148 @@ module CompilerService.AsyncMemoize open System open System.Threading -open Xunit open Internal.Utilities.Collections open System.Threading.Tasks open System.Diagnostics -open System.Collections.Concurrent + open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Diagnostics -open FSharp.Compiler.BuildGraph +open Xunit -let timeout = TimeSpan.FromSeconds 10. +[] +module internal JobEvents = -let waitFor (mre: ManualResetEvent) = - if not <| mre.WaitOne timeout then - failwith "waitFor timed out" + let publishEvent (cache: AsyncMemoize<_, _, _>) = + let wrapper = Event<_>() + cache.OnEvent (fun e -> lock wrapper <| fun () -> wrapper.Trigger e) + wrapper.Publish |> Event.map (fun (jobEvent, (_,k,_)) -> jobEvent, k) -let waitUntil condition value = - task { - let sw = Stopwatch.StartNew() - while not <| condition value do - if sw.Elapsed > timeout then - failwith "waitUntil timed out" - do! Task.Delay 10 - } + let collectEvents cache = + cache |> publishEvent |> Event.scan (fun es e -> e :: es) [] |> Event.map List.rev -let rec internal spinFor (duration: TimeSpan) = - async { - let sw = Stopwatch.StartNew() - do! Async.Sleep 10 - let remaining = duration - sw.Elapsed - if remaining > TimeSpan.Zero then - return! spinFor remaining - } - -#if BUILDING_WITH_LKG -type internal EventRecorder<'a, 'b, 'c when 'a : equality and 'b : equality>(memoize: AsyncMemoize<'a,'b,'c>) as self = -#else -type internal EventRecorder<'a, 'b, 'c when 'a : equality and 'b : equality and 'a:not null and 'b:not null>(memoize: AsyncMemoize<'a,'b,'c>) as self = -#endif + /// Exposes a live view of the list of JobEvents generated by AsyncMemoize. + let observe cache = + let updateAvailable = new AutoResetEvent(false) + let mutable recorded = [] - let events = ConcurrentQueue() + let update next = + Debug.WriteLine $"%A{next}" + recorded <- next + updateAvailable.Set() |> ignore - do memoize.OnEvent self.Add + collectEvents cache |> Event.add update - member _.Add (e, (_label, k, _version)) = events.Enqueue (e, k) + let waitForUpdate = updateAvailable |> Async.AwaitWaitHandle |> Async.Ignore - member _.Received value = events |> Seq.exists (fst >> (=) value) - - member _.CountOf value count = events |> Seq.filter (fst >> (=) value) |> Seq.length |> (=) count + async { + Debug.WriteLine $"current: %A{recorded}" + return recorded, waitForUpdate + } - member _.ShouldBe (expected) = - let expected = expected |> Seq.toArray - let actual = events |> Seq.toArray - Assert.Equal<_ array>(expected, actual) + let countOf value count events = events |> Seq.filter (fst >> (=) value) |> Seq.length |> (=) count - member _.Sequence = events |> Seq.map id + let received value events = events |> Seq.exists (fst >> (=) value) + let waitUntil observedCache condition = + let rec loop() = async { + let! current, waitForUpdate = observedCache + if current |> condition |> not then + do! waitForUpdate + return! loop() + } + loop() [] let ``Basics``() = - - let computation key = async { - do! Async.Sleep 1 - return key * 2 - } - - let memoize = AsyncMemoize() - let events = EventRecorder(memoize) - - let result = - seq { - memoize.Get'(5, computation 5) - memoize.Get'(5, computation 5) - memoize.Get'(2, computation 2) - memoize.Get'(5, computation 5) - memoize.Get'(3, computation 3) - memoize.Get'(2, computation 2) + task { + let computation key = async { + do! Async.Sleep 1 + return key * 2 } - |> Async.Parallel - |> Async.RunSynchronously - let expected = [| 10; 10; 4; 10; 6; 4|] + let memoize = AsyncMemoize() + let events = observe memoize + + let result = + seq { + memoize.Get'(5, computation 5) + memoize.Get'(5, computation 5) + memoize.Get'(2, computation 2) + memoize.Get'(5, computation 5) + memoize.Get'(3, computation 3) + memoize.Get'(2, computation 2) + } + |> Async.Parallel + |> Async.RunSynchronously - Assert.Equal(expected, result) + let expected = [| 10; 10; 4; 10; 6; 4|] - (waitUntil (events.CountOf Finished) 3).Wait() + Assert.Equal(expected, result) - let groups = events.Sequence |> Seq.groupBy snd |> Seq.toList - Assert.Equal(3, groups.Length) - for key, events in groups do - Assert.Equal>(Set [ Requested, key; Started, key; Finished, key ], Set events) + do! waitUntil events (countOf Finished 3) + let! current, _ = events + let groups = current |> Seq.groupBy snd |> Seq.toList + Assert.Equal(3, groups.Length) + for key, events in groups do + Assert.Equal>(Set [ Requested, key; Started, key; Finished, key ], Set events) + } [] let ``We can cancel a job`` () = task { - let jobStarted = new ManualResetEvent(false) + let jobStarted = new ManualResetEventSlim(false) + let cts = new CancellationTokenSource() + let ctsCancelled = new ManualResetEventSlim(false) - let computation action = async { - action() |> ignore - do! spinFor timeout + let computation = async { + jobStarted.Set() + ctsCancelled.Wait() + do! async { } failwith "Should be canceled before it gets here" } let memoize = AsyncMemoize<_, int, _>() - let events = EventRecorder(memoize) - - use cts1 = new CancellationTokenSource() - use cts2 = new CancellationTokenSource() - use cts3 = new CancellationTokenSource() + let events = observe memoize let key = 1 - let _task1 = Async.StartAsTask( memoize.Get'(key, computation jobStarted.Set), cancellationToken = cts1.Token) - - waitFor jobStarted - jobStarted.Reset() |> ignore + let _task1 = Async.StartAsTask( memoize.Get'(1, computation), cancellationToken = cts.Token) - let _task2 = Async.StartAsTask( memoize.Get'(key, computation ignore), cancellationToken = cts2.Token) - let _task3 = Async.StartAsTask( memoize.Get'(key, computation ignore), cancellationToken = cts3.Token) + jobStarted.Wait() + cts.Cancel() + ctsCancelled.Set() - do! waitUntil (events.CountOf Requested) 3 + do! waitUntil events (received Canceled) + let! current, _ = events - cts1.Cancel() - cts2.Cancel() - - waitFor jobStarted - - cts3.Cancel() - - do! waitUntil events.Received Canceled - - events.ShouldBe [ - Requested, key - Started, key - Requested, key - Requested, key - Restarted, key - Canceled, key - ] + Assert.Equal<_ list>( + [ + Requested, key + Started, key + Canceled, key + ], + current + ) } [] let ``Job is restarted if first requestor cancels`` () = task { - let jobStarted = new ManualResetEvent(false) + let jobStarted = new SemaphoreSlim(0) - let jobCanComplete = new ManualResetEvent(false) + let jobCanComplete = new ManualResetEventSlim(false) let computation key = async { - jobStarted.Set() |> ignore - waitFor jobCanComplete + jobStarted.Release() |> ignore + + jobCanComplete.Wait() return key * 2 } let memoize = AsyncMemoize<_, int, _>() - let events = EventRecorder(memoize) - + let events = observe memoize use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -169,48 +153,49 @@ let ``Job is restarted if first requestor cancels`` () = let _task1 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts1.Token) - waitFor jobStarted - jobStarted.Reset() |> ignore - + do! jobStarted.WaitAsync() let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) - do! waitUntil (events.CountOf Requested) 3 + do! waitUntil events (countOf Requested 3) cts1.Cancel() - waitFor jobStarted - jobCanComplete.Set() |> ignore + do! jobStarted.WaitAsync() + let! result = _task2 Assert.Equal(2, result) - events.ShouldBe [ - Requested, key + let! current, _ = events + + Assert.Equal<_ list>( + [ Requested, key Started, key Requested, key Requested, key Restarted, key - Finished, key ] + Finished, key ], + current + ) } [] let ``Job is restarted if first requestor cancels but keeps running if second requestor cancels`` () = task { - let jobStarted = new ManualResetEvent(false) + let jobStarted = new ManualResetEventSlim(false) - let jobCanComplete = new ManualResetEvent(false) + let jobCanComplete = new ManualResetEventSlim(false) let computation key = async { jobStarted.Set() |> ignore - waitFor jobCanComplete + jobCanComplete.Wait() return key * 2 } let memoize = AsyncMemoize<_, int, _>() - let events = EventRecorder(memoize) - + let events = observe memoize use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() @@ -220,17 +205,17 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let _task1 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts1.Token) - waitFor jobStarted + jobStarted.Wait() jobStarted.Reset() |> ignore let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) - do! waitUntil (events.CountOf Requested) 3 + do! waitUntil events (countOf Requested 3) cts1.Cancel() - waitFor jobStarted + jobStarted.Wait() cts2.Cancel() @@ -239,13 +224,17 @@ let ``Job is restarted if first requestor cancels but keeps running if second re let! result = _task3 Assert.Equal(2, result) - events.ShouldBe [ - Requested, key + let! current, _ = events + + Assert.Equal<_ list>( + [ Requested, key Started, key Requested, key Requested, key Restarted, key - Finished, key ] + Finished, key ], + current + ) } @@ -376,59 +365,56 @@ let ``Stress test`` () = [] [] let ``Cancel running jobs with the same key`` cancelDuplicate expectFinished = - task { - let cache = AsyncMemoize(cancelDuplicateRunningJobs=cancelDuplicate) - - let mutable started = 0 - let mutable finished = 0 + let cache = AsyncMemoize(cancelDuplicateRunningJobs=cancelDuplicate) - let job1started = new ManualResetEvent(false) - let job1finished = new ManualResetEvent(false) + let mutable started = 0 + let mutable finished = 0 - let jobCanContinue = new ManualResetEvent(false) + let job1started = new ManualResetEventSlim(false) + let job1finished = new ManualResetEventSlim(false) - let job2started = new ManualResetEvent(false) - let job2finished = new ManualResetEvent(false) + let jobCanContinue = new ManualResetEventSlim(false) - let work onStart onFinish = async { - Interlocked.Increment &started |> ignore - onStart() |> ignore - waitFor jobCanContinue - do! spinFor (TimeSpan.FromMilliseconds 100) - Interlocked.Increment &finished |> ignore - onFinish() |> ignore - } + let job2started = new ManualResetEventSlim(false) + let job2finished = new ManualResetEventSlim(false) - let key1 = - { new ICacheKey<_, _> with - member _.GetKey() = 1 - member _.GetVersion() = 1 - member _.GetLabel() = "key1" } + let work onStart onFinish = async { + Interlocked.Increment &started |> ignore + onStart() |> ignore + jobCanContinue.Wait() + do! Async.Sleep 100 + Interlocked.Increment &finished |> ignore + onFinish() |> ignore + } - cache.Get(key1, work job1started.Set job1finished.Set) |> Async.Start + let key1 = + { new ICacheKey<_, _> with + member _.GetKey() = 1 + member _.GetVersion() = 1 + member _.GetLabel() = "key1" } - waitFor job1started + cache.Get(key1, work job1started.Set job1finished.Set) |> Async.Catch |> Async.Ignore |> Async.Start - let key2 = - { new ICacheKey<_, _> with - member _.GetKey() = key1.GetKey() - member _.GetVersion() = key1.GetVersion() + 1 - member _.GetLabel() = "key2" } + job1started.Wait() - cache.Get(key2, work job2started.Set job2finished.Set ) |> Async.Start + let key2 = + { new ICacheKey<_, _> with + member _.GetKey() = key1.GetKey() + member _.GetVersion() = key1.GetVersion() + 1 + member _.GetLabel() = "key2" } - waitFor job2started + cache.Get(key2, work job2started.Set job2finished.Set ) |> Async.Catch |> Async.Ignore |> Async.Start - jobCanContinue.Set() |> ignore + job2started.Wait() - waitFor job2finished + jobCanContinue.Set() |> ignore - if not cancelDuplicate then - waitFor job1finished - - Assert.Equal((2, expectFinished), (started, finished)) - } + job2finished.Wait() + + if not cancelDuplicate then + job1finished.Wait() + Assert.Equal((2, expectFinished), (started, finished)) type DummyException(msg) = inherit Exception(msg) @@ -490,7 +476,7 @@ let ``Preserve thread static diagnostics`` () = let diagnostics = diagnosticsLogger.GetDiagnostics() - //Assert.Equal(3, diagnostics.Length) + Assert.Equal(4, diagnostics.Length) return result, diagnostics } @@ -498,9 +484,9 @@ let ``Preserve thread static diagnostics`` () = let results = (Task.WhenAll tasks).Result - let _diagnosticCounts = results |> Seq.map snd |> Seq.map Array.length |> Seq.groupBy id |> Seq.map (fun (k, v) -> k, v |> Seq.length) |> Seq.sortBy fst |> Seq.toList + let diagnosticCounts = results |> Seq.map snd |> Seq.map Array.length |> Seq.groupBy id |> Seq.map (fun (k, v) -> k, v |> Seq.length) |> Seq.sortBy fst |> Seq.toList - //Assert.Equal<(int * int) list>([4, 100], diagnosticCounts) + Assert.Equal<(int * int) list>([4, 100], diagnosticCounts) let diagnosticMessages = results |> Seq.map snd |> Seq.map (Array.map (fun (d, _) -> d.Exception.Message) >> Array.toList) |> Set @@ -523,7 +509,7 @@ let ``Preserve thread static diagnostics already completed job`` () = return Ok input } - async { + task { let diagnosticsLogger = CompilationDiagnosticLogger($"Testing", FSharpDiagnosticOptions.Default) @@ -534,10 +520,9 @@ let ``Preserve thread static diagnostics already completed job`` () = let diagnosticMessages = diagnosticsLogger.GetDiagnostics() |> Array.map (fun (d, _) -> d.Exception.Message) |> Array.toList - Assert.Equal>(["job 1 error"; "job 1 error"], diagnosticMessages) + Assert.Equal<_ list>(["job 1 error"; "job 1 error"], diagnosticMessages) } - |> Async.StartAsTask [] @@ -550,34 +535,22 @@ let ``We get diagnostics from the job that failed`` () = member _.GetVersion() = 1 member _.GetLabel() = "job1" } - let job (input: int) = async { - let ex = DummyException($"job {input} error") - do! Async.Sleep 100 - DiagnosticsThreadStatics.DiagnosticsLogger.Error(ex) + let job = async { + let ex = DummyException($"job error") + + // no recovery + DiagnosticsThreadStatics.DiagnosticsLogger.Error ex return 5 } - let result = - [1; 2] - |> Seq.map (fun i -> - async { - let diagnosticsLogger = CompilationDiagnosticLogger($"Testing", FSharpDiagnosticOptions.Default) - - use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Optimize) - try - let! _ = cache.Get(key, job i ) - () - with _ -> - () - let diagnosticMessages = diagnosticsLogger.GetDiagnostics() |> Array.map (fun (d, _) -> d.Exception.Message) |> Array.toList - - return diagnosticMessages - }) - |> Async.Parallel - |> Async.StartAsTask - |> (fun t -> t.Result) - |> Array.toList - - Assert.True( - result = [["job 1 error"]; ["job 1 error"]] || - result = [["job 2 error"]; ["job 2 error"]] ) + task { + let logger = CapturingDiagnosticsLogger("AsyncMemoize diagnostics test") + + SetThreadDiagnosticsLoggerNoUnwind logger + + do! cache.Get(key, job ) |> Async.Catch |> Async.Ignore + + let messages = logger.Diagnostics |> List.map fst |> List.map _.Exception.Message + + Assert.Equal<_ list>(["job error"], messages) + } From 370f035a65fad9dc787ab2cbf6ce889e05e279f5 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 12:47:35 +0200 Subject: [PATCH 05/13] use temp dir --- .../FSharpScriptTests.fs | 23 +++++++++++-------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs index aff47308ad2..bf3a9cbaac6 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs @@ -12,12 +12,16 @@ open System.Threading.Tasks open FSharp.Compiler.Interactive open FSharp.Compiler.Interactive.Shell open FSharp.Test.ScriptHelpers -open FSharp.Test.Utilities open Xunit type InteractiveTests() = + let copyHousingToTemp() = + let tempName = TestFramework.getTemporaryFileName() + File.Copy(__SOURCE_DIRECTORY__ ++ "housing.csv", tempName + ".csv") + tempName + [] member _.``ValueRestriction error message should not have type variables fully solved``() = use script = new FSharpScript() @@ -248,10 +252,10 @@ System.Configuration.ConfigurationManager.AppSettings.Item "Environment" <- "LOC if RuntimeInformation.ProcessArchitecture = Architecture.Arm64 then () else - let code = @" -#r ""nuget:Microsoft.ML,version=1.4.0-preview"" -#r ""nuget:Microsoft.ML.AutoML,version=0.16.0-preview"" -#r ""nuget:Microsoft.Data.Analysis,version=0.4.0"" + let code = $""" +#r "nuget:Microsoft.ML,version=1.4.0-preview" +#r "nuget:Microsoft.ML.AutoML,version=0.16.0-preview" +#r "nuget:Microsoft.Data.Analysis,version=0.4.0" open System open System.IO @@ -267,7 +271,7 @@ let Shuffle (arr:int[]) = arr.[i] <- temp arr -let housingPath = ""housing.csv"" +let housingPath = @"{copyHousingToTemp()}.csv" let housingData = DataFrame.LoadCsv(housingPath) let randomIndices = (Shuffle(Enumerable.Range(0, (int (housingData.Rows.Count) - 1)).ToArray())) let testSize = int (float (housingData.Rows.Count) * 0.1) @@ -281,11 +285,11 @@ open Microsoft.ML.AutoML let mlContext = MLContext() let experiment = mlContext.Auto().CreateRegressionExperiment(maxExperimentTimeInSeconds = 15u) -let result = experiment.Execute(housing_train, labelColumnName = ""median_house_value"") +let result = experiment.Execute(housing_train, labelColumnName = "median_house_value") let details = result.RunDetails -printfn ""%A"" result +printfn "{@"%A"}" result 123 -" +""" use script = new FSharpScript(additionalArgs=[| |]) let opt = script.Eval(code) |> getValue let value = opt.Value @@ -511,3 +515,4 @@ let add (col:IServiceCollection) = use script = new FSharpScript(additionalArgs=[| |]) let _value,diag = script.Eval(code) Assert.Empty(diag) + From 89525ff6f6c8c242d15b871b5fe5b16d676dad92 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 12:48:11 +0200 Subject: [PATCH 06/13] remove unnecessary timeout --- .../BuildGraphTests.fs | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs index 16b0ff7b878..4769b4c322d 100644 --- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs @@ -385,22 +385,17 @@ module BuildGraphTests = for i in 1 .. 300 do async { - Interlocked.Increment(&count) |> ignore - errorR (ExampleException $"{i}") + errorR (ExampleException $"{Interlocked.Increment(&count)}") + error (ExampleException $"{Interlocked.Increment(&count)}") } ] - let run = - tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.StartAsTask - - Assert.True( - run.Wait(1000), - "MultipleDiagnosticsLoggers.Parallel did not finish." - ) - - // Diagnostics from all started tasks should be collected despite the exception. - errorCountShouldBe count + task { + do! tasks |> MultipleDiagnosticsLoggers.Parallel |> Async.Catch |> Async.Ignore + // Diagnostics from all started tasks should be collected despite the exception. + errorCountShouldBe count + } [] let ``AsyncLocal diagnostics context flows correctly`` () = From abbabccc2e4af970a75abeec9f403a9720171820 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 12:49:30 +0200 Subject: [PATCH 07/13] improve timing and don't leave unobserved background tasks running --- .../ProjectAnalysisTests.fs | 9 +- .../Microsoft.FSharp.Control/AsyncModule.fs | 68 ++++---- .../Microsoft.FSharp.Control/AsyncType.fs | 61 ++++---- .../Microsoft.FSharp.Control/Cancellation.fs | 18 ++- .../MailboxProcessorType.fs | 147 +++++++++++++----- .../Microsoft.FSharp.Control/Tasks.fs | 45 +++--- .../Microsoft.FSharp.Control/TasksDynamic.fs | 45 +++--- 7 files changed, 240 insertions(+), 153 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs index 78d03ac8a9b..5752f9de41c 100644 --- a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs @@ -123,7 +123,14 @@ let ``Test project1 and make sure TcImports gets cleaned up`` () = let weakTcImports = test () checker.InvalidateConfiguration Project1.options checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() - GC.Collect(2, GCCollectionMode.Forced, blocking = true) + + //collect 2 more times for good measure, + // See for example: https://github.com/dotnet/runtime/discussions/108081 + GC.Collect() + GC.WaitForPendingFinalizers() + GC.Collect() + GC.WaitForPendingFinalizers() + Assert.False weakTcImports.IsAlive [] 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 145d9a70c3e..02b3c380950 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 @@ -7,6 +7,7 @@ namespace FSharp.Core.UnitTests.Control open System open System.Threading +open System.Threading.Tasks open FSharp.Core.UnitTests.LibraryTestFx open Xunit open FsCheck @@ -273,8 +274,7 @@ type AsyncModule() = } Async.RunSynchronously test - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.``OnCancel.RaceBetweenCancellationHandlerAndDisposingHandlerRegistration``() = let test() = use flag = new ManualResetEvent(false) @@ -297,8 +297,7 @@ type AsyncModule() = for _i = 1 to 300 do test() - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.``OnCancel.RaceBetweenCancellationAndDispose``() = let mutable flag = 0 let cts = new System.Threading.CancellationTokenSource() @@ -316,8 +315,7 @@ type AsyncModule() = :? System.OperationCanceledException -> () Assert.AreEqual(1, flag) - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.``OnCancel.CancelThatWasSignalledBeforeRunningTheComputation``() = let test() = let cts = new System.Threading.CancellationTokenSource() @@ -379,23 +377,25 @@ type AsyncModule() = [] member _.``AwaitWaitHandle.DisposedWaitHandle2``() = - let wh = new System.Threading.ManualResetEvent(false) - let barrier = new System.Threading.ManualResetEvent(false) + let wh = new ManualResetEvent(false) + let started = new ManualResetEventSlim(false) - let test = async { - let! timeout = Async.AwaitWaitHandle(wh, 10000) - Assert.False(timeout, "Timeout expected") - barrier.Set() |> ignore + let test = + async { + started.Set() + let! timeout = Async.AwaitWaitHandle(wh, 5000) + Assert.False(timeout, "Timeout expected") } - Async.Start test - - // await 3 secs then dispose waithandle - nothing should happen - let timeout = wait barrier 3000 - Assert.False(timeout, "Barrier was reached too early") - dispose wh - - let ok = wait barrier 10000 - if not ok then Assert.Fail("Async computation was not completed in given time") + |> Async.StartAsTask + + task { + started.Wait() + // Wait a moment then dispose waithandle - nothing should happen + do! Task.Delay 500 + Assert.False(test.IsCompleted, "Test completed too early") + dispose wh + do! test + } [] member _.``RunSynchronously.NoThreadJumpsAndTimeout``() = @@ -467,20 +467,19 @@ type AsyncModule() = [] member _.``error on one workflow should cancel all others``() = - let counter = - async { - let mutable counter = 0 - let job i = async { - if i = 55 then failwith "boom" - else - do! Async.Sleep 1000 - counter <- counter + 1 - } + let go = new ManualResetEvent(false) + let mutable counter = 0 + let job i = async { + if i = 55 then + go.Set() |> ignore + failwith "boom" + else + do! Async.AwaitWaitHandle go |> Async.Ignore + counter <- counter + 1 + } - let! _ = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch - do! Async.Sleep 5000 - return counter - } |> Async.RunSynchronously + let t = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch |> Async.Ignore |> Async.StartAsTask + t.Wait() Assert.AreEqual(0, counter) @@ -641,7 +640,6 @@ type AsyncModule() = member _.``Parallel with maxDegreeOfParallelism`` () = let mutable i = 1 let action j = async { - do! Async.Sleep 1 Assert.Equal(j, i) i <- i + 1 } diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 950432ccc8e..1b15be8fa98 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -54,16 +54,20 @@ type AsyncType() = [] member _.AsyncRunSynchronouslyReusesThreadPoolThread() = - let action = async { async { () } |> Async.RunSynchronously } - let computation = - [| for i in 1 .. 1000 -> action |] - |> Async.Parallel + let action _ = + async { + return + async { return Thread.CurrentThread.ManagedThreadId } + |> Async.RunSynchronously + } // This test needs approximately 1000 ThreadPool threads // if Async.RunSynchronously doesn't reuse them. - // In such case TimeoutException is raised - // since ThreadPool cannot provide 1000 threads in 1 second - // (the number of threads in ThreadPool is adjusted slowly). - Async.RunSynchronously(computation, timeout = 1000) |> ignore + let usedThreads = + Seq.init 1000 action + |> Async.Parallel + |> Async.RunSynchronously + |> Set.ofArray + Assert.True(usedThreads.Count < 256, $"RunSynchronously used {usedThreads.Count} threads.") [] [] @@ -231,7 +235,8 @@ type AsyncType() = use t = Async.StartAsTask a let mutable exceptionThrown = false try - waitASec t + // waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (t.IsFaulted) @@ -269,7 +274,7 @@ type AsyncType() = // printfn "%A" t.Status let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) @@ -302,56 +307,50 @@ type AsyncType() = use t = Async.StartImmediateAsTask a let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (t.IsFaulted) Assert.True(exceptionThrown) -#if IGNORED [] - [] member _.CancellationPropagatesToImmediateTask () = let a = async { - while true do () + while true do + do! Async.Sleep 100 } use t = Async.StartImmediateAsTask a Async.CancelDefaultToken () let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) -#endif -#if IGNORED [] - [] member _.CancellationPropagatesToGroupImmediate () = let ewh = new ManualResetEvent(false) - let cancelled = ref false + let mutable cancelled = false let a = async { - use! holder = Async.OnCancel (fun _ -> cancelled := true) + use! holder = Async.OnCancel (fun _ -> cancelled <- true) ewh.Set() |> Assert.True - while true do () + while true do + do! Async.Sleep 100 } let cts = new CancellationTokenSource() let token = cts.Token use t = Async.StartImmediateAsTask(a, cancellationToken=token) -// printfn "%A" t.Status ewh.WaitOne() |> Assert.True cts.Cancel() -// printfn "%A" t.Status let mutable exceptionThrown = false try - waitASec t + t.Wait() with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) - Assert.True(!cancelled) -#endif + Assert.True(cancelled) [] member _.TaskAsyncValue () = @@ -411,8 +410,7 @@ type AsyncType() = } Async.RunSynchronously(a) |> Assert.True - // test is flaky: https://github.com/dotnet/fsharp/issues/11586 - //[] + [] member _.TaskAsyncValueCancellation () = use ewh = new ManualResetEvent(false) let cts = new CancellationTokenSource() @@ -430,9 +428,11 @@ type AsyncType() = :? TaskCanceledException -> ewh.Set() |> ignore // this is ok } - Async.Start a + let t1 = Async.StartAsTask a cts.Cancel() ewh.WaitOne(10000) |> ignore + // Don't leave unobserved background tasks, because they can crash the test run. + t1.Wait() [] member _.NonGenericTaskAsyncValue () = @@ -473,9 +473,10 @@ type AsyncType() = :? TaskCanceledException -> ewh.Set() |> ignore // this is ok } - Async.Start a + let t1 = Async.StartAsTask a cts.Cancel() ewh.WaitOne(10000) |> ignore + t1.Wait() [] member _.CancellationExceptionThrown () = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs index 4e04f64bc1f..3a0bf67f468 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs @@ -5,6 +5,7 @@ namespace FSharp.Core.UnitTests.Control open System open FSharp.Core.UnitTests.LibraryTestFx open Xunit +open FSharp.Test open System.Threading @@ -269,13 +270,15 @@ type CancellationType() = |> StartAsTaskProperCancel None (Some cts.Token) // First cancel the token, then set the task as cancelled. - async { - do! Async.Sleep 100 - cts.Cancel() - do! Async.Sleep 100 - tcs.TrySetException (TimeoutException "Task timed out after token.") - |> ignore - } |> Async.Start + let t1 = + async { + do! Async.Sleep 100 + cts.Cancel() + do! Async.Sleep 100 + tcs.TrySetException (TimeoutException "Task timed out after token.") + |> ignore + } + |> Async.StartAsTask try let res = t.Wait(2000) @@ -283,6 +286,7 @@ type CancellationType() = printfn "failure msg: %s" msg Assert.Fail (msg) with :? AggregateException as agg -> () + t1.Wait() [] member this.Equality() = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs index 904bc7dc622..5f760ec893a 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs @@ -125,7 +125,7 @@ type MailboxProcessorType() = use mre2 = new ManualResetEventSlim(false) // https://github.com/dotnet/fsharp/issues/3337 - let cts = new CancellationTokenSource () + use cts = new CancellationTokenSource () let addMsg msg = match result with @@ -204,25 +204,25 @@ type MailboxProcessorType() = [] member this.``Receive Races with Post``() = - let receiveEv = new ManualResetEvent(false) - let postEv = new ManualResetEvent(false) - let finishedEv = new ManualResetEvent(false) + let receiveEv = new AutoResetEvent(false) + let postEv = new AutoResetEvent(false) + let finishedEv = new AutoResetEvent(false) + use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start ( fun inbox -> async { while true do - let w = receiveEv.WaitOne() - receiveEv.Reset() |> ignore + receiveEv.WaitOne() |> ignore let! (msg) = inbox.Receive () finishedEv.Set() |> ignore - }) + }, + cancellationToken = cts.Token) let post = async { - while true do - let r = postEv.WaitOne() - postEv.Reset() |> ignore + while not cts.IsCancellationRequested do + postEv.WaitOne() |> ignore mb.Post(fun () -> ()) - } |> Async.Start + } |> Async.StartAsTask for i in 0 .. 100000 do if i % 2 = 0 then receiveEv.Set() |> ignore @@ -232,32 +232,37 @@ type MailboxProcessorType() = receiveEv.Set() |> ignore finishedEv.WaitOne() |> ignore - finishedEv.Reset() |> ignore + + cts.Cancel() + // Let the post task finish. + postEv.Set() |> ignore + post.Wait() [] member this.``Receive Races with Post on timeout``() = - let receiveEv = new ManualResetEvent(false) - let postEv = new ManualResetEvent(false) - let finishedEv = new ManualResetEvent(false) + let receiveEv = new AutoResetEvent(false) + let postEv = new AutoResetEvent(false) + let finishedEv = new AutoResetEvent(false) + use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start ( fun inbox -> async { while true do - let w = receiveEv.WaitOne() - receiveEv.Reset() |> ignore + receiveEv.WaitOne() |> ignore let! (msg) = inbox.Receive (5000) finishedEv.Set() |> ignore - }) + }, + cancellationToken = cts.Token) let isErrored = mb.Error |> Async.AwaitEvent |> Async.StartAsTask let post = async { - while true do - let r = postEv.WaitOne() - postEv.Reset() |> ignore + while not cts.IsCancellationRequested do + postEv.WaitOne() |> ignore mb.Post(fun () -> ()) - } |> Async.Start + } + |> Async.StartAsTask for i in 0 .. 10000 do if i % 2 = 0 then @@ -271,32 +276,35 @@ type MailboxProcessorType() = if isErrored.IsCompleted then raise <| Exception("Mailbox should not fail!", isErrored.Result) - finishedEv.Reset() |> ignore + cts.Cancel() + // Let the post task finish. + postEv.Set() |> ignore + post.Wait() [] member this.``TryReceive Races with Post on timeout``() = - let receiveEv = new ManualResetEvent(false) - let postEv = new ManualResetEvent(false) - let finishedEv = new ManualResetEvent(false) + let receiveEv = new AutoResetEvent(false) + let postEv = new AutoResetEvent(false) + let finishedEv = new AutoResetEvent(false) + use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start ( fun inbox -> async { while true do - let w = receiveEv.WaitOne() - receiveEv.Reset() |> ignore + receiveEv.WaitOne() |> ignore let! (msg) = inbox.TryReceive (5000) finishedEv.Set() |> ignore - }) + }, + cancellationToken = cts.Token) let isErrored = mb.Error |> Async.AwaitEvent |> Async.StartAsTask let post = async { - while true do - let r = postEv.WaitOne() - postEv.Reset() |> ignore + while not cts.IsCancellationRequested do + postEv.WaitOne() |> ignore mb.Post(fun () -> ()) - } |> Async.Start + } |> Async.StartAsTask for i in 0 .. 10000 do if i % 2 = 0 then @@ -310,9 +318,13 @@ type MailboxProcessorType() = if isErrored.IsCompleted then raise <| Exception("Mailbox should not fail!", isErrored.Result) - finishedEv.Reset() |> ignore + cts.Cancel() + // Let the post task finish. + postEv.Set() |> ignore + post.Wait() - [] + // TODO: Attempts to access disposed event at mailbox.fs:193 + [] member this.``After dispose is called, mailbox should stop receiving and processing messages``() = task { let mutable isSkip = false let mutable actualSkipMessagesCount = 0 @@ -320,8 +332,9 @@ type MailboxProcessorType() = let sleepDueTime = 100 let expectedMessagesCount = 2 use mre = new ManualResetEventSlim(false) + use cts = new CancellationTokenSource() let mb = - MailboxProcessor.Start(fun b -> + MailboxProcessor.Start((fun b -> let rec loop() = async { match! b.Receive() with @@ -338,7 +351,8 @@ type MailboxProcessorType() = return! loop() | _ -> () } - loop() + loop()), + cancellationToken = cts.Token ) let post() = Increment 1 |> mb.Post @@ -353,6 +367,7 @@ type MailboxProcessorType() = Assert.Equal(expectedMessagesCount, actualMessagesCount) Assert.Equal(0, actualSkipMessagesCount) Assert.Equal(0, mb.CurrentQueueLength) + cts.Cancel() } [] @@ -363,6 +378,7 @@ type MailboxProcessorType() = let sleepDueTime = 100 let expectedMessagesCount = 2 use mre = new ManualResetEventSlim(false) + use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start((fun b -> let rec loop() = @@ -382,7 +398,8 @@ type MailboxProcessorType() = | _ -> () } loop()), - true + true, + cancellationToken = cts.Token ) let post() = Increment 1 |> mb.Post @@ -397,6 +414,7 @@ type MailboxProcessorType() = Assert.Equal(expectedMessagesCount, actualMessagesCount) Assert.Equal(0, actualSkipMessagesCount) Assert.Equal(0, mb.CurrentQueueLength) + cts.Cancel() } [] @@ -496,3 +514,56 @@ type MailboxProcessorType() = // If StartImmediate worked correctly, the information should be identical since // the threads should be the same. Assert.Equal(callingThreadInfo, mailboxThreadInfo) + +module MailboxProcessorType = + + [] + let TryScan () = + let tcs = TaskCompletionSource<_>() + use mailbox = + new MailboxProcessor(fun inbox -> async { + do! + inbox.TryScan( function + | Reset -> async { tcs.SetResult "Reset processed" } |> Some + | _ -> None) + |> Async.Ignore + }) + mailbox.Start() + + for i in 1 .. 100 do + mailbox.Post(Increment i) + mailbox.Post Reset + + Assert.Equal("Reset processed", tcs.Task.Result) + Assert.Equal(100, mailbox.CurrentQueueLength) + + [] + let ``TryScan with timeout`` () = + let tcs = TaskCompletionSource<_>() + use mailbox = + new MailboxProcessor(fun inbox -> + let rec loop i = async { + match! + inbox.TryScan( function + | Reset -> async { tcs.SetResult i } |> Some + | _ -> None) + with + | None -> do! loop (i + 1) + | _ -> () + } + loop 1 + ) + mailbox.DefaultTimeout <- 10 + mailbox.Start() + + let iteration = + task { + for i in 1 .. 100 do + mailbox.Post(Increment 1) + do! Task.Delay 10 + mailbox.Post Reset + + return! tcs.Task + } + + Assert.True(iteration.Result > 1, "TryScan did not timeout") diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs index 5d533b880c3..8097c2d10f5 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs @@ -236,15 +236,16 @@ type Basics() = [] member _.testNonBlocking() = printfn "Running testNonBlocking..." - let sw = Stopwatch() - sw.Start() + let allowContinue = new SemaphoreSlim(0) + let finished = new ManualResetEventSlim() let t = task { - do! Task.Yield() + do! allowContinue.WaitAsync() Thread.Sleep(100) + finished.Set() } - sw.Stop() - require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" + allowContinue.Release() |> ignore + require (not finished.IsSet) "sleep blocked caller" t.Wait() [] @@ -908,58 +909,60 @@ type Basics() = [] member _.testExceptionThrownInFinally() = printfn "running testExceptionThrownInFinally" - for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + for i in 1 .. 5 do + use stepOutside = new SemaphoreSlim(0) + use ranInitial = new ManualResetEventSlim() + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = task { try - ranInitial <- true + ranInitial.Set() do! Task.Yield() Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true + ranNext.Set() finally ranFinally <- ranFinally + 1 failtest "finally exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + require ranInitial.IsSet "didn't run initial" + require (not ranNext.IsSet) "ran next too early" try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] member _.test2ndExceptionThrownInFinally() = printfn "running test2ndExceptionThrownInFinally" for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + use ranInitial = new ManualResetEventSlim() + use continueTask = new SemaphoreSlim(0) + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = task { try - ranInitial <- true + ranInitial.Set() + do! continueTask.WaitAsync() + ranNext.Set() do! Task.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true failtest "uhoh" finally ranFinally <- ranFinally + 1 failtest "2nd exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + ranInitial.Wait() + continueTask.Release() |> ignore try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs index c811aecaa5c..7f844e99d96 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs @@ -357,15 +357,16 @@ type Basics() = [] member _.testNonBlocking() = printfn "Running testNonBlocking..." - let sw = Stopwatch() - sw.Start() + let allowContinue = new SemaphoreSlim(0) + let finished = new ManualResetEventSlim() let t = taskDynamic { - do! Task.Yield() + do! allowContinue.WaitAsync() Thread.Sleep(100) + finished.Set() } - sw.Stop() - require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" + allowContinue.Release() |> ignore + require (not finished.IsSet) "sleep blocked caller" t.Wait() [] @@ -982,58 +983,60 @@ type Basics() = [] member _.testExceptionThrownInFinally() = printfn "running testExceptionThrownInFinally" - for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + for i in 1 .. 5 do + use stepOutside = new SemaphoreSlim(0) + use ranInitial = new ManualResetEventSlim() + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = taskDynamic { try - ranInitial <- true + ranInitial.Set() do! Task.Yield() Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true + ranNext.Set() finally ranFinally <- ranFinally + 1 failtest "finally exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + require ranInitial.IsSet "didn't run initial" + require (not ranNext.IsSet) "ran next too early" try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] member _.test2ndExceptionThrownInFinally() = printfn "running test2ndExceptionThrownInFinally" for i in 1 .. 5 do - let mutable ranInitial = false - let mutable ranNext = false + use ranInitial = new ManualResetEventSlim() + use continueTask = new SemaphoreSlim(0) + use ranNext = new ManualResetEventSlim() let mutable ranFinally = 0 let t = taskDynamic { try - ranInitial <- true + ranInitial.Set() + do! continueTask.WaitAsync() + ranNext.Set() do! Task.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes - ranNext <- true failtest "uhoh" finally ranFinally <- ranFinally + 1 failtest "2nd exn!" } - require ranInitial "didn't run initial" - require (not ranNext) "ran next too early" + ranInitial.Wait() + continueTask.Release() |> ignore try t.Wait() require false "shouldn't get here" with | _ -> () - require ranNext "didn't run next" + require ranNext.IsSet "didn't run next" require (ranFinally = 1) "didn't run finally exactly once" [] From 64c6564204edc694332e1630d02fa5a947890a82 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 7 Oct 2024 19:40:29 +0200 Subject: [PATCH 08/13] remove another timeout --- .../Microsoft.FSharp.Control/Cancellation.fs | 51 ++++++++++++------- 1 file changed, 33 insertions(+), 18 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs index 3a0bf67f468..cecfaec7590 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs @@ -7,6 +7,7 @@ open FSharp.Core.UnitTests.LibraryTestFx open Xunit open FSharp.Test open System.Threading +open System.Threading.Tasks type CancellationType() = @@ -230,6 +231,7 @@ type CancellationType() = } asyncs |> Async.Parallel |> Async.RunSynchronously |> ignore + // See https://github.com/dotnet/fsharp/issues/3254 [] member this.AwaitTaskCancellationAfterAsyncTokenCancellation() = let StartCatchCancellation cancellationToken (work) = @@ -263,30 +265,43 @@ type CancellationType() = let cts = new CancellationTokenSource() let tcs = System.Threading.Tasks.TaskCompletionSource<_>() - let t = + let test() = async { do! tcs.Task |> Async.AwaitTask } - |> StartAsTaskProperCancel None (Some cts.Token) + |> StartAsTaskProperCancel None (Some cts.Token) :> Task // First cancel the token, then set the task as cancelled. - let t1 = - async { - do! Async.Sleep 100 - cts.Cancel() - do! Async.Sleep 100 - tcs.TrySetException (TimeoutException "Task timed out after token.") - |> ignore - } - |> Async.StartAsTask + async { + do! Async.Sleep 100 + cts.Cancel() + do! Async.Sleep 100 + tcs.TrySetException (TimeoutException "Task timed out after token.") + |> ignore + } |> Async.Start - try - let res = t.Wait(2000) - let msg = sprintf "Excepted TimeoutException wrapped in an AggregateException, but got %A" res - printfn "failure msg: %s" msg - Assert.Fail (msg) - with :? AggregateException as agg -> () - t1.Wait() + task { + let! agg = Assert.ThrowsAsync(test) + let inner = agg.InnerException + Assert.True(inner :? TimeoutException, $"Excepted TimeoutException wrapped in an AggregateException, but got %A{inner}") + } + + // Simpler regression test for https://github.com/dotnet/fsharp/issues/3254 + [] + member this.AwaitTaskCancellationAfterAsyncTokenCancellation2() = + let tcs = new TaskCompletionSource() + let cts = new CancellationTokenSource() + let _ = cts.Token.Register(fun () -> tcs.SetResult 42) + Assert.ThrowsAsync( fun () -> + Async.StartAsTask( + async { + cts.CancelAfter 100 + let! result = tcs.Task |> Async.AwaitTask + return result + }, + cancellationToken = cts.Token + ) + ) [] member this.Equality() = From 013ea28a2037efc7db2bfa0765c1a4125ab03cac Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 8 Oct 2024 12:07:30 +0200 Subject: [PATCH 09/13] disable flaky TryScan test in script --- tests/fsharp/core/controlMailbox/test.fsx | 56 +++++++++++++---------- 1 file changed, 33 insertions(+), 23 deletions(-) diff --git a/tests/fsharp/core/controlMailbox/test.fsx b/tests/fsharp/core/controlMailbox/test.fsx index a29c16a85bf..5aa65035ecd 100644 --- a/tests/fsharp/core/controlMailbox/test.fsx +++ b/tests/fsharp/core/controlMailbox/test.fsx @@ -240,34 +240,44 @@ module MailboxProcessorBasicTests = return !received}) n + +(* Disabled for timing issues. Some replacement TryScan tests were added to FSharp.Core.UnitTests. + for i in 1..10 do for sleep in [0;1;10] do for timeout in [10;1;0] do - checkAsync + check (sprintf "cf72361: MailboxProcessor TryScan w/timeout=%d sleep=%d iteration=%d" timeout sleep i) - ( - let timedOut = TaskCompletionSource<_>() - use mb = new MailboxProcessor(fun inbox -> - async { - let! result = inbox.TryScan((fun i -> if i >= 0 then async { return i } |> Some else None), timeout=timeout) - timedOut.SetResult result.IsNone - } - ) + (let timedOut = ref None + let mb = new MailboxProcessor(fun inbox -> + async { + let result = ref None + let count = ref 0 + while (!result).IsNone && !count < 5 do + let! curResult = inbox.TryScan((fun i -> if i >= 0 then async { return i } |> Some else None), timeout=timeout) + result := curResult + count := !count + 1 + match !result with + | None -> + timedOut := Some true + | Some i -> + timedOut := Some false + }) mb.Start() - - let _ = task { - do! Task.Delay 1000 - timedOut.TrySetResult false |> ignore - } - - task { - while not timedOut.Task.IsCompleted do - do! Task.Delay sleep - mb.Post(-1) - return! timedOut.Task - } - ) - (true) + let w = System.Diagnostics.Stopwatch() + w.Start() + while w.ElapsedMilliseconds < 1000L && (!timedOut).IsNone do + mb.Post(-1) +#if NETCOREAPP + Task.Delay(1).Wait(); +#else + System.Threading.Thread.Sleep(1) +#endif + mb.Post(0) + !timedOut) + (Some true) + +*) checkAsync "cf72361: MailboxProcessor TryScan wo/timeout" (task { From 8c2c6383213de5e19e49df1ac3da6e04e6f09e67 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 8 Oct 2024 21:19:44 +0200 Subject: [PATCH 10/13] Don't cancel MailboxProcessor body. --- .../MailboxProcessorType.fs | 36 +++++++------------ 1 file changed, 13 insertions(+), 23 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs index 5f760ec893a..f3964aaa78c 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs @@ -215,8 +215,7 @@ type MailboxProcessorType() = receiveEv.WaitOne() |> ignore let! (msg) = inbox.Receive () finishedEv.Set() |> ignore - }, - cancellationToken = cts.Token) + }) let post = async { while not cts.IsCancellationRequested do @@ -251,18 +250,16 @@ type MailboxProcessorType() = receiveEv.WaitOne() |> ignore let! (msg) = inbox.Receive (5000) finishedEv.Set() |> ignore - }, - cancellationToken = cts.Token) + }) let isErrored = mb.Error |> Async.AwaitEvent |> Async.StartAsTask let post = - async { + backgroundTask { while not cts.IsCancellationRequested do postEv.WaitOne() |> ignore mb.Post(fun () -> ()) } - |> Async.StartAsTask for i in 0 .. 10000 do if i % 2 = 0 then @@ -294,17 +291,17 @@ type MailboxProcessorType() = receiveEv.WaitOne() |> ignore let! (msg) = inbox.TryReceive (5000) finishedEv.Set() |> ignore - }, - cancellationToken = cts.Token) + } + ) let isErrored = mb.Error |> Async.AwaitEvent |> Async.StartAsTask let post = - async { + backgroundTask { while not cts.IsCancellationRequested do postEv.WaitOne() |> ignore mb.Post(fun () -> ()) - } |> Async.StartAsTask + } for i in 0 .. 10000 do if i % 2 = 0 then @@ -319,12 +316,10 @@ type MailboxProcessorType() = raise <| Exception("Mailbox should not fail!", isErrored.Result) cts.Cancel() - // Let the post task finish. postEv.Set() |> ignore post.Wait() - // TODO: Attempts to access disposed event at mailbox.fs:193 - [] + [] member this.``After dispose is called, mailbox should stop receiving and processing messages``() = task { let mutable isSkip = false let mutable actualSkipMessagesCount = 0 @@ -332,9 +327,8 @@ type MailboxProcessorType() = let sleepDueTime = 100 let expectedMessagesCount = 2 use mre = new ManualResetEventSlim(false) - use cts = new CancellationTokenSource() let mb = - MailboxProcessor.Start((fun b -> + MailboxProcessor.Start(fun b -> let rec loop() = async { match! b.Receive() with @@ -351,8 +345,7 @@ type MailboxProcessorType() = return! loop() | _ -> () } - loop()), - cancellationToken = cts.Token + loop() ) let post() = Increment 1 |> mb.Post @@ -367,7 +360,6 @@ type MailboxProcessorType() = Assert.Equal(expectedMessagesCount, actualMessagesCount) Assert.Equal(0, actualSkipMessagesCount) Assert.Equal(0, mb.CurrentQueueLength) - cts.Cancel() } [] @@ -378,7 +370,6 @@ type MailboxProcessorType() = let sleepDueTime = 100 let expectedMessagesCount = 2 use mre = new ManualResetEventSlim(false) - use cts = new CancellationTokenSource() let mb = MailboxProcessor.Start((fun b -> let rec loop() = @@ -398,8 +389,7 @@ type MailboxProcessorType() = | _ -> () } loop()), - true, - cancellationToken = cts.Token + true ) let post() = Increment 1 |> mb.Post @@ -414,7 +404,7 @@ type MailboxProcessorType() = Assert.Equal(expectedMessagesCount, actualMessagesCount) Assert.Equal(0, actualSkipMessagesCount) Assert.Equal(0, mb.CurrentQueueLength) - cts.Cancel() + } [] @@ -549,7 +539,7 @@ module MailboxProcessorType = | _ -> None) with | None -> do! loop (i + 1) - | _ -> () + | _ -> () } loop 1 ) From a9f3e2f4f117a3b1cd1fe894bee9446aa6d42b63 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 9 Oct 2024 19:08:06 +0200 Subject: [PATCH 11/13] fix test --- .../Microsoft.FSharp.Control/AsyncModule.fs | 29 ++++++++++--------- 1 file changed, 16 insertions(+), 13 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 02b3c380950..af2e17040d0 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 @@ -467,21 +467,24 @@ type AsyncModule() = [] member _.``error on one workflow should cancel all others``() = - let go = new ManualResetEvent(false) - let mutable counter = 0 - let job i = async { - if i = 55 then - go.Set() |> ignore + task { + use failOnlyOne = new Semaphore(0, 1) + let mutable cancelled = 0 + let mutable started = 0 + + let job i = async { + use! holder = Async.OnCancel (fun () -> Interlocked.Increment &cancelled |> ignore) + Interlocked.Increment &started |> ignore + do! failOnlyOne |> Async.AwaitWaitHandle |> Async.Ignore failwith "boom" - else - do! Async.AwaitWaitHandle go |> Async.Ignore - counter <- counter + 1 - } - - let t = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch |> Async.Ignore |> Async.StartAsTask - t.Wait() + } - Assert.AreEqual(0, counter) + let test = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch |> Async.Ignore |> Async.StartAsTask + do! Task.Delay 100 + failOnlyOne.Release() |> ignore + do! test + Assert.Equal(started - 1, cancelled) + } [] member _.``AwaitWaitHandle.ExceptionsAfterTimeout``() = From bb8bcd0b8629a4d75f84e4b0dac71f1c82fa1207 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Thu, 10 Oct 2024 17:20:43 +0200 Subject: [PATCH 12/13] fix test --- .../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 af2e17040d0..213ff435adf 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 @@ -473,8 +473,8 @@ type AsyncModule() = let mutable started = 0 let job i = async { - use! holder = Async.OnCancel (fun () -> Interlocked.Increment &cancelled |> ignore) Interlocked.Increment &started |> ignore + use! holder = Async.OnCancel (fun () -> Interlocked.Increment &cancelled |> ignore) do! failOnlyOne |> Async.AwaitWaitHandle |> Async.Ignore failwith "boom" } From 2617978337ea8d0eeee3042aee599604baa11c29 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 11 Oct 2024 11:06:25 +0200 Subject: [PATCH 13/13] catch TCE --- .../CompilerService/AsyncMemoize.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 802f07012de..7b65ba798fe 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -98,6 +98,7 @@ let ``We can cancel a job`` () = let ctsCancelled = new ManualResetEventSlim(false) let computation = async { + use! _catch = Async.OnCancel ignore jobStarted.Set() ctsCancelled.Wait() do! async { }