Tests: add helper Stress attribute for stress testing (#18452)

Author: majocha

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
+[<Theory; Stress(Count = 1000)>]
+```
+it will start it many times at the same time, and execute in parallel.
+
+
+
 
 ### Updating FCS surface area baselines
 

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\"

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

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

tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj

@@ -10,7 +10,8 @@
     <DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
     <Optimize>false</Optimize>
     <Tailcalls>false</Tailcalls>
-    <IsTestProject>false</IsTestProject>
+    <UnitTestType>xunit</UnitTestType>
+    <IsTestProject>true</IsTestProject>
     <OtherFlags>$(OtherFlags) --warnon:1182 --realsig-</OtherFlags>
     <CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
     <!--Extra xUnit customizations, not required for the test suite to work, but can speed up local test runs and help with debugging.-->
@@ -23,10 +24,9 @@
   </PropertyGroup>
 
   <ItemGroup>
-    <ProjectCapability Remove="TestContainer" />
-  </ItemGroup>
-
-  <ItemGroup>
+    <Content Include="xunit.runner.json">
+      <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
+    </Content>
     <Compile Include="..\scripts\scriptlib.fsx">
       <Link>scriptlib.fsx</Link>
     </Compile>
@@ -46,11 +46,10 @@
     <Compile Include="ReflectionHelper.fs" />
     <Compile Include="SurfaceArea.fs" />
     <Compile Include="XunitHelpers.fs" />
+    <Compile Include="XunitSetup.fs" />
+    <Compile Include="Tests.fs" />
   </ItemGroup>
 
-  <ItemGroup>
-    <None Include="XunitSetup.fs" />
-  </ItemGroup>
 
   <ItemGroup>
     <ProjectReference Include="$(FSharpSourcesRoot)\Compiler\FSharp.Compiler.Service.fsproj" />
@@ -70,11 +69,6 @@
     <ProjectReference Include="$(FSharpSourcesRoot)\FSharp.Build\FSharp.Build.fsproj" />
   </ItemGroup>
 
-
-  <ItemGroup>
-    <PackageReference Include="xunit" Version="$(XUnitVersion)" />
-  </ItemGroup>
-
   <!-- Runtime dependencies. Beware. -->
   <ItemGroup>
     <PackageReference Include="Microsoft.NETCore.ILDAsm" Version="$(MicrosoftNETCoreILDAsmVersion)" />

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"
+
+[<Theory(Skip = "Explicit, unskip to run"); Stress(true, Count = 50)>]
+let ``Stress attribute should catch intermittent failure`` shouldFail _ =
+    failing.Run shouldFail
+
+[<Theory; Stress(Count = 5)>]
+let ``Stress attribute works`` _ =
+    passing.Run false
+
+[<Fact>]
+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)

tests/FSharp.Test.Utilities/XunitHelpers.fs

@@ -21,6 +21,14 @@ open OpenTelemetry.Trace
 [<AttributeUsage(AttributeTargets.Class ||| AttributeTargets.Method, AllowMultiple = false)>]
 type RunTestCasesInSequenceAttribute() = inherit Attribute()
 
+// Helper for stress testing.
+// Runs a test case many times in parallel.
+// Example usage: [<Theory; Stress(Count = 1000)>]
+type StressAttribute([<ParamArray>] 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:

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
+}