diff --git a/DEVGUIDE.md b/DEVGUIDE.md index 28b511fac04..c551c90af2b 100644 --- a/DEVGUIDE.md +++ b/DEVGUIDE.md @@ -252,6 +252,15 @@ For example: module TimeCritical = ``` +For stress testing async code you can use a custom `FSharp.Test.StressAttribute`. +For example, applied to a single xUnit test case: +```fsharp +[] +``` +it will start it many times at the same time, and execute in parallel. + + + ### Updating FCS surface area baselines diff --git a/eng/Build.ps1 b/eng/Build.ps1 index 32dcca19336..91ed6cd4008 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -615,7 +615,8 @@ try { if ($testDesktop -and $ci) { $bgJob = TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -asBackgroundJob $true - + + TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Test.Utilities\FSharp.Test.Utilities.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Test.Utilities\" TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" diff --git a/eng/build.sh b/eng/build.sh index 1263445973f..650f78163e5 100755 --- a/eng/build.sh +++ b/eng/build.sh @@ -331,6 +331,7 @@ BuildSolution if [[ "$test_core_clr" == true ]]; then coreclrtestframework=$tfm + Test --testproject "$repo_root/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj" --targetframework $coreclrtestframework Test --testproject "$repo_root/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj" --targetframework $coreclrtestframework Test --testproject "$repo_root/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj" --targetframework $coreclrtestframework Test --testproject "$repo_root/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj" --targetframework $coreclrtestframework diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index f37b64eb0f5..77e8f4b2137 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -422,18 +422,19 @@ let ``Cancel running jobs with the same key`` () = // detach requests from their running computations cts.Cancel() + // Cancel the Get requests, leaving the jobs running unawaited. for job in jobsToCancel do assertTaskCanceled job + // Start another request. let job = cache.Get(key 11, work) |> Async.StartAsTask // up til now the jobs should have been running unobserved let current = eventsWhen events (received Requested) Assert.Equal(0, current |> countOf Canceled) - // waitUntil events (countOf Canceled >> (=) 10) - - waitUntil events (received Started) + waitUntil events (countOf Started >> (=) 11) + // Allow the single current request to finish. jobCanContinue.Set() |> ignore job.Wait() diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index 37c1940b7a9..b98f57603c6 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -10,7 +10,8 @@ true false false - false + xunit + true $(OtherFlags) --warnon:1182 --realsig- true @@ -23,10 +24,9 @@ - - - - + + PreserveNewest + scriptlib.fsx @@ -46,11 +46,10 @@ + + - - - @@ -70,11 +69,6 @@ - - - - - diff --git a/tests/FSharp.Test.Utilities/Tests.fs b/tests/FSharp.Test.Utilities/Tests.fs new file mode 100644 index 00000000000..9561f1bf08f --- /dev/null +++ b/tests/FSharp.Test.Utilities/Tests.fs @@ -0,0 +1,45 @@ +module FSharp.Test.UtilitiesTests + +open System +open System.Threading +open Xunit +open FSharp.Test + +type RunOrFail(name) = + let mutable count = 0 + member _.Run(shouldFail: bool) = + let count = Interlocked.Increment &count + if shouldFail && count = 42 then + failwith $"{name}, failed as expected on {count}" + else + printfn $"{name}, iteration {count} passed" + count + +let passing = RunOrFail "Passing" +let failing = RunOrFail "Failing" + +[] +let ``Stress attribute should catch intermittent failure`` shouldFail _ = + failing.Run shouldFail + +[] +let ``Stress attribute works`` _ = + passing.Run false + +[] +let ``TestConsole captures output`` () = + let rnd = Random() + let task n = + async { + use console = new TestConsole.ExecutionCapture() + do! Async.Sleep (rnd.Next 50) + printf $"Hello, world! {n}" + do! Async.Sleep (rnd.Next 50) + eprintf $"Some error {n}" + return console.OutText, console.ErrorText + } + + let expected = [ for n in 0 .. 9 -> $"Hello, world! {n}", $"Some error {n}" ] + + let results = Seq.init 10 task |> Async.Parallel |> Async.RunSynchronously + Assert.Equal(expected, results) diff --git a/tests/FSharp.Test.Utilities/XunitHelpers.fs b/tests/FSharp.Test.Utilities/XunitHelpers.fs index cf7ecf3b2cf..34a44df17ed 100644 --- a/tests/FSharp.Test.Utilities/XunitHelpers.fs +++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs @@ -21,6 +21,14 @@ open OpenTelemetry.Trace [] type RunTestCasesInSequenceAttribute() = inherit Attribute() +// Helper for stress testing. +// Runs a test case many times in parallel. +// Example usage: [] +type StressAttribute([] data: obj array) = + inherit DataAttribute() + member val Count = 1 with get, set + override this.GetData _ = Seq.init this.Count (fun i -> [| yield! data; yield box i |]) + #if XUNIT_EXTRAS // To use xUnit means to customize it. The following abomination adds 2 features: diff --git a/tests/FSharp.Test.Utilities/xunit.runner.json b/tests/FSharp.Test.Utilities/xunit.runner.json new file mode 100644 index 00000000000..b01c50a3cb5 --- /dev/null +++ b/tests/FSharp.Test.Utilities/xunit.runner.json @@ -0,0 +1,5 @@ +{ + "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", + "appDomain": "denied", + "parallelizeAssembly": true +}