Some more assorted tests improvements (#17931)

tests/FSharp.Compiler.Service.Tests/Common.fs

@@ -476,7 +476,7 @@ let assertRange
 [<AutoOpen>]
 module TempDirUtils =
     let getTempPath dir =
-        Path.Combine(Path.GetTempPath(), dir)
+        Path.Combine(TestFramework.tempDirectoryOfThisTestRun, dir)
 
     /// Returns the file name part of a temp file name created with tryCreateTemporaryFileName ()
     /// and an added process id and thread id to ensure uniqueness between threads.

tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs

@@ -108,6 +108,9 @@ let ``Test project1 whole project errors`` () =
 [<Fact>]
 let ``Test project1 and make sure TcImports gets cleaned up`` () =
 
+    // A private checker for this test.
+    let checker = FSharpChecker.Create()
+
     let test () =
         let _, checkFileAnswer = checker.ParseAndCheckFileInProject(Project1.fileName1, 0, Project1.fileSource1, Project1.options) |> Async.RunImmediate
         match checkFileAnswer with
@@ -123,15 +126,7 @@ let ``Test project1 and make sure TcImports gets cleaned up`` () =
     let weakTcImports = test ()
     checker.InvalidateConfiguration Project1.options
     checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients()
-
-    //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
+    System.Threading.SpinWait.SpinUntil(fun () -> not weakTcImports.IsAlive)
 
 [<Fact>]
 let ``Test Project1 should have protected FullName and TryFullName return same results`` () =

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

@@ -379,23 +379,23 @@ type AsyncModule() =
     member _.``AwaitWaitHandle.DisposedWaitHandle2``() = 
         let wh = new ManualResetEvent(false)
         let started = new ManualResetEventSlim(false)
-
-        let test = 
-            async {
+        let cts = new CancellationTokenSource()
+        let test =
+            Async.StartAsTask( async {
+                printfn "starting the test"
                 started.Set()
-                let! timeout = Async.AwaitWaitHandle(wh, 5000)
-                Assert.False(timeout, "Timeout expected")
-            }
-            |> 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
-        }
+                let! _ = Async.AwaitWaitHandle(wh)
+                printfn "should never get here"
+            }, cancellationToken = cts.Token)
+
+        // Wait for the test to start then dispose waithandle - nothing should happen.
+        started.Wait()
+        Assert.False(test.Wait 100, "Test completed too early.")
+        printfn "disposing"
+        dispose wh
+        printfn "cancelling in 1 second"
+        cts.CancelAfter 1000
+        Assert.ThrowsAsync<TaskCanceledException>(fun () -> test)
 
     [<Fact>]
     member _.``RunSynchronously.NoThreadJumpsAndTimeout``() = 
@@ -469,21 +469,27 @@ type AsyncModule() =
     member _.``error on one workflow should cancel all others``() =
         task {
             use failOnlyOne = new Semaphore(0, 1)
-            let mutable cancelled = 0
-            let mutable started = 0
+            // Start from 1.
+            let mutable running = new CountdownEvent(1)
 
             let job i = async {
-                Interlocked.Increment &started |> ignore
-                use! holder = Async.OnCancel (fun () -> Interlocked.Increment &cancelled |> ignore)
+                use! holder = Async.OnCancel (running.Signal >> ignore)
+                running.AddCount 1
                 do! failOnlyOne |> Async.AwaitWaitHandle |> Async.Ignore
+                running.Signal() |> ignore
                 failwith "boom" 
             }
 
             let test = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch |> Async.Ignore |> Async.StartAsTask
-            do! Task.Delay 100
+            // Wait for more than one job to start
+            while running.CurrentCount < 2 do
+                do! Task.Yield()
+            printfn $"started jobs: {running.CurrentCount - 1}"
             failOnlyOne.Release() |> ignore
             do! test
-            Assert.Equal(started - 1, cancelled)
+            // running.CurrentCount should eventually settle back at 1. Signal it one more time and it should be 0.
+            running.Signal() |> ignore
+            return! Async.AwaitWaitHandle running.WaitHandle
         }
 
     [<Fact>]

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

@@ -67,6 +67,8 @@ type AsyncType() =
             |> Async.Parallel
             |> Async.RunSynchronously
             |> Set.ofArray
+        printfn $"RunSynchronously used {usedThreads.Count} threads. Environment.ProcessorCount is {Environment.ProcessorCount}."
+        // Some arbitrary large number but in practice it should not use more threads than there are CPU cores.
         Assert.True(usedThreads.Count < 256, $"RunSynchronously used {usedThreads.Count} threads.")
 
     [<Theory>]

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

@@ -12,6 +12,15 @@ open System.Threading.Tasks
 
 type CancellationType() =
 
+    let ordered() =
+        let mutable current = 1
+
+        fun n -> 
+            async {
+                SpinWait.SpinUntil(fun () -> current = n)
+                Interlocked.Increment &current |> ignore
+            }
+
     [<Fact>]
     member this.CancellationNoCallbacks() =
         let _ : CancellationTokenSource = null // compilation test
@@ -234,6 +243,8 @@ type CancellationType() =
     // See https://github.com/dotnet/fsharp/issues/3254
     [<Fact>]
     member this.AwaitTaskCancellationAfterAsyncTokenCancellation() =
+        let step = ordered()
+
         let StartCatchCancellation cancellationToken (work) =
             Async.FromContinuations(fun (cont, econt, _) ->
               // When the child is cancelled, report OperationCancelled
@@ -267,25 +278,26 @@ type CancellationType() =
         let tcs = System.Threading.Tasks.TaskCompletionSource<_>()
         let t =
             async {
+                do! step 1
                 do! tcs.Task |> Async.AwaitTask
             }
             |> StartAsTaskProperCancel None (Some cts.Token)
 
         // First cancel the token, then set the task as cancelled.
-        async {
-            do! Async.Sleep 100
+        task {
+            do! step 2
             cts.Cancel()
-            do! Async.Sleep 100
+            do! step 3
             tcs.TrySetException (TimeoutException "Task timed out after token.")
-                |> ignore
-        } |> Async.Start
+            |> ignore
 
-        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 -> ()
+            try
+                let res = t.Wait()
+                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 -> ()
+        }
 
     // Simpler regression test for https://github.com/dotnet/fsharp/issues/3254
     [<Fact>]

tests/FSharp.Test.Utilities/DirectoryAttribute.fs

@@ -9,6 +9,7 @@ open Xunit.Sdk
 open FSharp.Compiler.IO
 open FSharp.Test.Compiler
 open FSharp.Test.Utilities
+open TestFramework
 
 /// Attribute to use with Xunit's TheoryAttribute.
 /// Takes a directory, relative to current test suite's root.
@@ -22,7 +23,6 @@ type DirectoryAttribute(dir: string) =
             invalidArg "dir" "Directory cannot be null, empty or whitespace only."
 
     let dirInfo = normalizePathSeparator (Path.GetFullPath(dir))
-    let outputDirectory methodName extraDirectory = getTestOutputDirectory dir methodName extraDirectory 
     let mutable baselineSuffix = ""
     let mutable includes = Array.empty<string>
 
@@ -31,19 +31,8 @@ type DirectoryAttribute(dir: string) =
         | true -> Some (File.ReadAllText path)
         | _ -> None
 
-    let createCompilationUnit path (filename: string) methodName multipleFiles =
-        // if there are multiple files being processed, add extra directory for each test to avoid reference file conflicts
-        let extraDirectory =
-            if multipleFiles then
-                let extension = Path.GetExtension(filename)
-                filename.Substring(0, filename.Length - extension.Length) // remove .fs/the extension
-                |> normalizeName
-            else ""
-        let outputDirectory = outputDirectory methodName extraDirectory
-        let outputDirectoryPath =
-            match outputDirectory with
-            | Some path -> path.FullName
-            | None -> failwith "Can't set the output directory"
+    let createCompilationUnit path (filename: string) =
+        let outputDirectoryPath = createTemporaryDirectory "dir"
         let sourceFilePath = normalizePathSeparator (path ++ filename)
         let fsBslFilePath = sourceFilePath + baselineSuffix + ".err.bsl"
         let ilBslFilePath =
@@ -97,7 +86,7 @@ type DirectoryAttribute(dir: string) =
             Name              = Some filename
             IgnoreWarnings    = false
             References        = []
-            OutputDirectory   = outputDirectory
+            OutputDirectory   = Some (DirectoryInfo(outputDirectoryPath))
             TargetFramework   = TargetFramework.Current
             StaticLink        = false
             } |> FS
@@ -107,7 +96,7 @@ type DirectoryAttribute(dir: string) =
     member _.BaselineSuffix with get() = baselineSuffix and set v = baselineSuffix <- v
     member _.Includes with get() = includes and set v = includes <- v
 
-    override _.GetData(method: MethodInfo) =
+    override _.GetData _ =
         if not (Directory.Exists(dirInfo)) then
             failwith (sprintf "Directory does not exist: \"%s\"." dirInfo)
 
@@ -127,8 +116,6 @@ type DirectoryAttribute(dir: string) =
             if not <| FileSystem.FileExistsShim(f) then
                 failwithf "Requested file \"%s\" not found.\nAll files: %A.\nIncludes:%A." f allFiles includes
 
-        let multipleFiles = fsFiles |> Array.length > 1
-
         fsFiles
-        |> Array.map (fun fs -> createCompilationUnit dirInfo fs method.Name multipleFiles)
+        |> Array.map (fun fs -> createCompilationUnit dirInfo fs)
         |> Seq.map (fun c -> [| c |])