Args (#82)

Consumer/Consumer.fsproj

@@ -10,6 +10,9 @@
     <ItemGroup>
         <Compile Include="NoAttribute.fs" />
         <Compile Include="Inconclusive.fs" />
+        <Compile Include="TestNonParallel.fs" />
+        <Compile Include="TestParallel.fs" />
+        <Compile Include="TestStdout.fs" />
         <Compile Include="TestParameterisedFixture.fs" />
         <Compile Include="TestSetUp.fs" />
         <Compile Include="TestValues.fs" />

Consumer/TestNonParallel.fs

@@ -0,0 +1,19 @@
+namespace Consumer
+
+open System
+open System.Threading
+open NUnit.Framework
+open FsUnitTyped
+
+[<TestFixture>]
+[<NonParallelizable>]
+module TestNonParallel =
+    let defaults = List.init 40 id
+    let lock = ref 0
+
+    [<TestCaseSource(nameof defaults)>]
+    let ``Default thing, but not parallel`` (i : int) =
+        Interlocked.Increment lock |> shouldEqual 1
+        Thread.Sleep (TimeSpan.FromMilliseconds (float i))
+        lock.Value <- 0
+        i |> shouldEqual i

Consumer/TestParallel.fs

@@ -0,0 +1,66 @@
+namespace Consumer
+
+open System
+open System.Threading
+open NUnit.Framework
+open FsUnitTyped
+
+[<TestFixture>]
+[<Parallelizable>]
+module TestParallelDefault =
+
+    let defaults = List.init 60 id
+
+    [<TestCaseSource(nameof defaults)>]
+    let ``Default thing, no scope`` (i : int) =
+        Console.WriteLine i
+        Thread.Sleep (TimeSpan.FromMilliseconds (float i))
+        i |> shouldEqual i
+
+[<TestFixture>]
+[<Parallelizable(ParallelScope.All)>]
+module TestParallelAllScope =
+
+    let defaults = List.init 60 id
+
+    [<TestCaseSource(nameof defaults)>]
+    let ``Thing, all scope`` (i : int) =
+        Console.WriteLine i
+        Thread.Sleep (TimeSpan.FromMilliseconds (float i))
+        i |> shouldEqual i
+
+[<TestFixture>]
+[<Parallelizable(ParallelScope.Self)>]
+module TestParallelSelfScope =
+
+    let defaults = List.init 60 id
+
+    [<TestCaseSource(nameof defaults)>]
+    let ``Thing, self scope`` (i : int) =
+        Console.WriteLine i
+        Thread.Sleep (TimeSpan.FromMilliseconds (float i))
+        i |> shouldEqual i
+
+[<TestFixture>]
+[<Parallelizable(ParallelScope.Children)>]
+module TestParallelChildrenScope =
+
+    let defaults = List.init 60 id
+
+    [<TestCaseSource(nameof defaults)>]
+    let ``Thing, children scope`` (i : int) =
+        Console.WriteLine i
+        Thread.Sleep (TimeSpan.FromMilliseconds (float i))
+        i |> shouldEqual i
+
+[<TestFixture>]
+[<Parallelizable(ParallelScope.Fixtures)>]
+module TestParallelFixturesScope =
+
+    let defaults = List.init 60 id
+
+    [<TestCaseSource(nameof defaults)>]
+    let ``Thing, fixtures scope`` (i : int) =
+        Console.WriteLine i
+        Thread.Sleep (TimeSpan.FromMilliseconds (float i))
+        i |> shouldEqual i

Consumer/TestSetUp.fs

@@ -1,5 +1,6 @@
 namespace Consumer
 
+open System
 open FsUnitTyped
 open System.Threading
 open NUnit.Framework
@@ -11,6 +12,8 @@ module TestSetUp =
 
     [<OneTimeSetUp>]
     let oneTimeSetUp () =
+        Console.WriteLine "I'm being set up for the first time!"
+
         if Interlocked.Increment haveOneTimeSetUp <> 1 then
             failwith "one time setup happened more than once"
 
@@ -22,12 +25,14 @@ module TestSetUp =
 
     [<SetUp>]
     let setUp () =
+        Console.WriteLine "It's a set-up!"
         haveOneTimeSetUp.Value |> shouldEqual 1
         let newId = Interlocked.Increment setUpTimes
         lock setUpTimesSeen (fun () -> setUpTimesSeen.Add newId)
 
     [<TearDown>]
     let tearDown () =
+        Console.WriteLine "I'm a tear-down!"
         let newId = Interlocked.Increment tearDownTimes
         lock tearDownTimesSeen (fun () -> tearDownTimesSeen.Add newId)
 
@@ -35,19 +40,23 @@ module TestSetUp =
 
     [<OneTimeTearDown>]
     let oneTimeTearDown () =
+        Console.WriteLine "I'm being torn down, finally!"
+
         if Interlocked.Increment haveOneTimeTearDown <> 1 then
             failwith "one time tear down happened more than once"
 
         setUpTimesSeen
         |> Seq.toList
+        |> List.sort
         // Six tests: one for Test, two for the TestCase, three for the Repeat.
         |> shouldEqual [ 1..6 ]
 
-        tearDownTimesSeen |> Seq.toList |> shouldEqual [ 1..6 ]
+        tearDownTimesSeen |> Seq.toList |> List.sort |> shouldEqual [ 1..6 ]
 
     [<Test>]
     let ``Test 1`` () =
         haveOneTimeTearDown.Value |> shouldEqual 0
+        Console.WriteLine "By the way, I'm test 1"
         1 |> shouldEqual 1
 
     [<TestCase "h">]

Consumer/TestStdout.fs

@@ -0,0 +1,13 @@
+namespace Consumer
+
+open System
+open NUnit.Framework
+
+[<TestFixture>]
+module TestStdout =
+
+    [<Test>]
+    let ``Stdout is redirected`` () =
+        Console.Out.WriteLine "Hi!"
+        Console.WriteLine "Hi! part 2"
+        Console.Error.WriteLine "Bye!"

Consumer/TestValues.fs

@@ -86,14 +86,42 @@ module TestValues =
 
     [<OneTimeTearDown>]
     let ``Values are all OK`` () =
-        seen1 |> Seq.toList |> shouldEqual [ true ; false ]
-        seen2 |> Seq.toList |> shouldEqual [ (true, false) ; (false, true) ]
-        seen3 |> Seq.toList |> shouldEqual [ (88, box 29) ; (31, box 0) ]
-        seen4 |> Seq.toList |> shouldEqual [ ("hi", box "ohh") ; ("bye", null) ]
-        seen5 |> Seq.toList |> shouldEqual [ (88, box 29) ; (31, box 29) ]
-        seen6 |> Seq.toList |> shouldEqual [ ("hi", box "ohh") ; ("bye", box "ohh") ]
-        seen7 |> Seq.toList |> shouldEqual [ (88, box 29) ; (31, box 29) ]
-        seen8 |> Seq.toList |> shouldEqual [ ("hi", box "ohh") ; ("bye", box "ohh") ]
+        seen1 |> Seq.toList |> List.sort |> shouldEqual [ false ; true ]
+
+        seen2
+        |> Seq.toList
+        |> List.sort
+        |> shouldEqual [ (false, true) ; (true, false) ]
+
+        seen3
+        |> Seq.toList
+        |> List.sortBy fst
+        |> shouldEqual [ (31, box 0) ; (88, box 29) ]
+
+        seen4
+        |> Seq.toList
+        |> List.sortBy fst
+        |> shouldEqual [ ("bye", null) ; ("hi", box "ohh") ]
+
+        seen5
+        |> Seq.toList
+        |> List.sortBy fst
+        |> shouldEqual [ (31, box 29) ; (88, box 29) ]
+
+        seen6
+        |> Seq.toList
+        |> List.sortBy fst
+        |> shouldEqual [ ("bye", box "ohh") ; ("hi", box "ohh") ]
+
+        seen7
+        |> Seq.toList
+        |> List.sortBy fst
+        |> shouldEqual [ (31, box 29) ; (88, box 29) ]
+
+        seen8
+        |> Seq.toList
+        |> List.sortBy fst
+        |> shouldEqual [ ("bye", box "ohh") ; ("hi", box "ohh") ]
 
         seen9
         |> Seq.toList

README.md

@@ -8,3 +8,9 @@ To supply special characters in a string, XML-encode them and `"quote"` the stri
 We support at least the [documented `dotnet test` examples](https://learn.microsoft.com/en-us/dotnet/core/testing/selective-unit-tests).
 However, we would recommend phrasing some of them differently, for maximum peace of mind:
 * `FullyQualifiedName=MyNamespace.MyTestsClass<ParameterType1%2CParameterType2>.MyTestMethod`. This would be better phrased with quotes and escaping as `FullyQualifiedName="MyNamespace.MyTestsClass&lt;ParameterType1%2CParameterType2&gt;.MyTestMethod"`
+
+## Parallelism
+
+WoofWare.NUnitTestRunner has *limited* support for parallelism.
+By default, we run tests serially; we may or may not respect the NUnit parallelism attributes to any given extent (but we will never incorrectly run tests in parallel).
+For example, as of this writing, we do not run any tests in parallel (but the internal infrastructure is set up so that we will be able to do this soon).

WoofWare.NUnitTestRunner.Lib/Context.fs

@@ -0,0 +1,180 @@
+namespace WoofWare.NUnitTestRunner
+
+open System
+open System.Collections.Generic
+open System.IO
+open System.Reflection
+open System.Runtime.Loader
+open System.Text
+open System.Threading
+
+type internal OutputStreamId = | OutputStreamId of Guid
+
+type private ThreadAwareWriter
+    (
+        local : AsyncLocal<OutputStreamId>,
+        underlying : Dictionary<OutputStreamId, TextWriter>,
+        mem : Dictionary<OutputStreamId, MemoryStream>
+    )
+    =
+    inherit TextWriter ()
+    override _.get_Encoding () = Encoding.Default
+
+    override this.Write (v : char) : unit =
+        use prev = ExecutionContext.Capture ()
+
+        (fun _ ->
+            (fun () ->
+                match underlying.TryGetValue local.Value with
+                | true, output -> output.Write v
+                | false, _ ->
+                    let wanted =
+                        underlying |> Seq.map (fun (KeyValue (a, b)) -> $"%O{a}") |> String.concat "\n"
+
+                    failwith $"no such context: %O{local.Value}\nwanted:\n"
+            )
+            |> lock underlying
+        )
+        |> fun action -> ExecutionContext.Run (prev, action, ())
+
+    override this.WriteLine (v : string) : unit =
+        use prev = ExecutionContext.Capture ()
+
+        (fun _ ->
+            (fun () ->
+                match underlying.TryGetValue local.Value with
+                | true, output -> output.WriteLine v
+                | false, _ ->
+                    let wanted =
+                        underlying |> Seq.map (fun (KeyValue (a, b)) -> $"%O{a}") |> String.concat "\n"
+
+                    failwith $"no such context: %O{local.Value}\nwanted:\n"
+            )
+            |> lock underlying
+        )
+        |> fun action -> ExecutionContext.Run (prev, action, ())
+
+/// Wraps up the necessary context to intercept global state.
+type TestContexts =
+    private
+        {
+            /// Accesses to this must be locked on StdOutWriters.
+            StdOuts : Dictionary<OutputStreamId, MemoryStream>
+            /// Accesses to this must be locked on StdErrWriters.
+            StdErrs : Dictionary<OutputStreamId, MemoryStream>
+            StdOutWriters : Dictionary<OutputStreamId, TextWriter>
+            StdErrWriters : Dictionary<OutputStreamId, TextWriter>
+            StdOutWriter : TextWriter
+            StdErrWriter : TextWriter
+            AsyncLocal : AsyncLocal<OutputStreamId>
+        }
+
+    /// Call this exactly once.
+    static member Empty () =
+        let stdouts = Dictionary ()
+        let stderrs = Dictionary ()
+        let stdoutWriters = Dictionary ()
+        let stderrWriters = Dictionary ()
+        let local = AsyncLocal ()
+        let stdoutWriter = new ThreadAwareWriter (local, stdoutWriters, stdouts)
+        let stderrWriter = new ThreadAwareWriter (local, stderrWriters, stderrs)
+
+        {
+            StdOuts = stdouts
+            StdErrs = stderrs
+            StdOutWriter = stdoutWriter
+            StdErrWriter = stderrWriter
+            StdOutWriters = stdoutWriters
+            StdErrWriters = stderrWriters
+            AsyncLocal = local
+        }
+
+    member internal this.Stdout : TextWriter = this.StdOutWriter
+    member internal this.Stderr : TextWriter = this.StdErrWriter
+
+    member internal this.DumpStdout (id : OutputStreamId) : string =
+        lock
+            this.StdOutWriters
+            (fun () ->
+                this.StdOutWriters.[id].Flush ()
+                this.StdOuts.[id].ToArray ()
+            )
+        |> Encoding.Default.GetString
+
+    member internal this.DumpStderr (id : OutputStreamId) : string =
+        lock
+            this.StdErrWriters
+            (fun () ->
+                this.StdErrWriters.[id].Flush ()
+                this.StdErrs.[id].ToArray ()
+            )
+        |> Encoding.Default.GetString
+
+    member internal this.NewOutputs () =
+        let id = Guid.NewGuid () |> OutputStreamId
+        let msOut = new MemoryStream ()
+        let wrOut = new StreamWriter (msOut)
+        let msErr = new MemoryStream ()
+        let wrErr = new StreamWriter (msErr)
+
+        lock
+            this.StdOutWriters
+            (fun () ->
+                this.StdOutWriters.Add (id, wrOut)
+                this.StdOuts.Add (id, msOut)
+            )
+
+        lock
+            this.StdErrWriters
+            (fun () ->
+                this.StdErrWriters.Add (id, wrErr)
+                this.StdErrs.Add (id, msErr)
+            )
+
+        id
+
+    interface IDisposable with
+        member this.Dispose () =
+            // TODO: dispose the streams
+            ()
+
+/// A separate AssemblyLoadContext within which you can run the tests in the given DLL.
+/// Supply places to find the .NET runtimes.
+type LoadContext (dll : FileInfo, runtimes : DirectoryInfo list, contexts : TestContexts) =
+    inherit AssemblyLoadContext ()
+
+    /// Load the assembly with the given name into this assembly context.
+    /// This additionally monkey-patches System.Console: it performs SetOut and SetError on them
+    /// so that they redirect their outputs into the given `TestContexts`.
+    override this.Load (target : AssemblyName) : Assembly =
+        let path = Path.Combine (dll.Directory.FullName, $"%s{target.Name}.dll")
+
+        let assy =
+            if File.Exists path then
+                this.LoadFromAssemblyPath path
+            else
+
+            runtimes
+            |> List.tryPick (fun di ->
+                let path = Path.Combine (di.FullName, $"%s{target.Name}.dll")
+
+                if File.Exists path then
+                    this.LoadFromAssemblyPath path |> Some
+                else
+                    None
+            )
+            |> Option.defaultValue null
+
+        if target.Name = "System.Console" then
+            if isNull assy then
+                failwith "could not monkey-patch System.Console"
+            else
+                let consoleType = assy.GetType "System.Console"
+                let setOut = consoleType.GetMethod "SetOut"
+                setOut.Invoke ((null : obj), [| contexts.Stdout |]) |> unbox<unit>
+                let setErr = consoleType.GetMethod "SetError"
+                setErr.Invoke ((null : obj), [| contexts.Stderr |]) |> unbox<unit>
+
+            assy
+        else
+            assy

WoofWare.NUnitTestRunner.Lib/Domain.fs

@@ -31,6 +31,36 @@ type Combinatorial =
     /// each", and so on. Spare slots are filled with `Unchecked.defaultof<_>`.
     | Sequential
 
+/// Describes the level of parallelism permitted in some context.
+[<RequireQualifiedAccess>]
+type ClassParallelScope =
+    /// "I may be run in parallel with other tests, although my children might not be able to run in parallel with each
+    /// other".
+    | Self
+    /// "The set of things I contain may be run in parallel with itself".
+    | Children
+    /// "Fixtures within me may be run in parallel with each other, but the tests within a given fixture might not
+    /// be runnable in parallel with each other".
+    | Fixtures
+    /// "All my descendents are happy to run in parallel with anything else, and also so am I".
+    | All
+
+/// Describes the level of parallelism permitted within an assembly.
+[<RequireQualifiedAccess>]
+type AssemblyParallelScope =
+    /// "The set of things I contain may be run in parallel with itself".
+    | Children
+    /// "Fixtures within me may be run in parallel with each other, but the tests within a given fixture might not
+    /// necessarily be runnable in parallel with each other".
+    | Fixtures
+
+/// Describes whether a test can be run concurrently with other tests.
+type Parallelizable<'scope> =
+    /// This test is happy, under some conditions (specified by the scope), to be run alongside other tests.
+    | Yes of 'scope
+    /// This test must always be run on its own.
+    | No
+
 /// A single method or member which holds some tests. (Often such a member will represent only one test, but e.g.
 /// if it has [<TestCaseSource>] then it represents multiple tests.)
 type SingleTestMethod =
@@ -49,6 +79,8 @@ type SingleTestMethod =
         /// If this test has data supplied by `[<Value>]` annotations, specifies how those annotations are combined
         /// to produce the complete collection of args.
         Combinatorial : Combinatorial option
+        /// If this test has declared a parallelisability, that goes here.
+        Parallelize : Parallelizable<unit> option
     }
 
     /// Human-readable name of this test method.
@@ -56,6 +88,7 @@ type SingleTestMethod =
 
 /// A test fixture (usually represented by the [<TestFixture>]` attribute), which may contain many tests,
 /// each of which may run many times.
+[<NoComparison>]
 type TestFixture =
     {
         /// The assembly which contains this TestFixture, loaded into a separate context.
@@ -85,10 +118,12 @@ type TestFixture =
         Parameters : obj list list
         /// The individual test methods present within this fixture.
         Tests : SingleTestMethod list
+        /// If this fixture has declared a parallelisability, that goes here.
+        Parallelize : Parallelizable<ClassParallelScope> option
     }
 
     /// A test fixture about which we know nothing. No tests, no setup/teardown.
-    static member Empty (ty : Type) (args : obj list list) =
+    static member Empty (ty : Type) (par : Parallelizable<ClassParallelScope> option) (args : obj list list) =
         {
             ContainingAssembly = ty.Assembly
             Type = ty
@@ -99,6 +134,7 @@ type TestFixture =
             TearDown = []
             Parameters = args
             Tests = []
+            Parallelize = par
         }
 
 /// User code in the unit under test has failed somehow.

WoofWare.NUnitTestRunner.Lib/DotnetRuntime.fs

@@ -7,11 +7,7 @@ open WoofWare.DotnetRuntimeLocator
 /// Functions for locating .NET runtimes.
 [<RequireQualifiedAccess>]
 module DotnetRuntime =
-    let private selectRuntime
-        (config : RuntimeOptions)
-        (f : DotnetEnvironmentInfo)
-        : Choice<DotnetEnvironmentFrameworkInfo, DotnetEnvironmentSdkInfo> option
-        =
+    let private selectRuntime (config : RuntimeOptions) (f : DotnetEnvironmentInfo) : DirectoryInfo list =
         let rollForward =
             match Environment.GetEnvironmentVariable "DOTNET_ROLL_FORWARD" with
             | null ->
@@ -66,15 +62,13 @@ module DotnetRuntime =
 
                     name, data.Installed
                 )
-                // TODO: how do we select between many available frameworks?
-                |> Seq.tryHead
+                |> Seq.toList
 
-            match available with
-            | Some (_, f) -> Some (Choice1Of2 f)
-            | None ->
-                // TODO: maybe we can ask the SDK. But we keep on trucking: maybe we're self-contained,
-                // and we'll actually find all the runtime next to the DLL.
-                None
+            // TODO: maybe we can ask the SDK if we don't have any runtimes.
+            // But we keep on trucking: maybe we're self-contained, and we'll actually find all the runtime next to the
+            // DLL.
+            available
+            |> List.map (fun (_name, runtime) -> DirectoryInfo $"%s{runtime.Path}/%s{runtime.Version}")
         | _ -> failwith "non-minor RollForward not supported yet; please shout if you want it"
 
     /// Given an executable DLL, locate the .NET runtime that can best run it.
@@ -96,9 +90,4 @@ module DotnetRuntime =
 
         let runtime = selectRuntime runtimeConfig availableRuntimes
 
-        match runtime with
-        | None ->
-            // Keep on trucking: let's be optimistic and hope that we're self-contained.
-            [ dll.Directory ]
-        | Some (Choice1Of2 runtime) -> [ dll.Directory ; DirectoryInfo $"%s{runtime.Path}/%s{runtime.Version}" ]
-        | Some (Choice2Of2 sdk) -> [ dll.Directory ; DirectoryInfo sdk.Path ]
+        dll.Directory :: runtime

WoofWare.NUnitTestRunner.Lib/ParallelQueue.fs

@@ -0,0 +1,422 @@
+namespace WoofWare.NUnitTestRunner
+
+open System
+open System.Threading
+open System.Threading.Tasks
+
+type private ThunkEvaluator<'ret> =
+    abstract Eval<'a> : (unit -> 'a) -> AsyncReplyChannel<'a> -> 'ret
+
+type private ThunkCrate =
+    abstract Apply<'ret> : ThunkEvaluator<'ret> -> 'ret
+
+[<RequireQualifiedAccess>]
+module private ThunkCrate =
+    let make<'a> (t : unit -> 'a) (rc : AsyncReplyChannel<'a>) : ThunkCrate =
+        { new ThunkCrate with
+            member _.Apply e = e.Eval t rc
+        }
+
+type private FakeUnit = FakeUnit
+
+/// A handle to a running test fixture.
+type TestFixtureRunningToken = private | TestFixtureRunningToken of TestFixture
+
+/// A handle to a test fixture whose setup method has been called.
+type TestFixtureSetupToken = private | TestFixtureSetupToken of TestFixture
+
+[<RequireQualifiedAccess>]
+module private TestFixtureSetupToken =
+    let vouchNoSetupRequired (TestFixtureRunningToken tf) = TestFixtureSetupToken tf
+
+/// A handle to a test fixture whose setup method has been called.
+type TestFixtureTearDownToken = private | TestFixtureTearDownToken of TestFixture
+
+[<RequireQualifiedAccess>]
+module private TestFixtureTearDownToken =
+    let vouchNoTearDownRequired (TestFixtureSetupToken tf) = TestFixtureTearDownToken tf
+
+[<RequireQualifiedAccess>]
+type private MailboxMessage =
+    | Quit of AsyncReplyChannel<unit>
+    /// Check current state, see if we need to start more tests, etc.
+    | Reconcile
+    | RunTest of within : TestFixture * Parallelizable<unit> option * test : ThunkCrate
+    | BeginTestFixture of TestFixture * AsyncReplyChannel<TestFixtureRunningToken>
+    | EndTestFixture of TestFixtureTearDownToken * AsyncReplyChannel<unit>
+
+type private RunningFixture =
+    {
+        Fixture : TestFixture
+        RunningCanParallelize : bool
+        Running : Task list
+        Waiting : ((unit -> Task) * Parallelizable<unit> option) list
+    }
+
+    static member Make (f : TestFixture) =
+        {
+            Fixture = f
+            Running = []
+            RunningCanParallelize = true
+            Waiting = []
+        }
+
+type private RunningState =
+    {
+        MaxParallelism : int
+        // TODO: make these efficiently look-up-able
+        CurrentlyRunning : RunningFixture list
+        Waiting : (TestFixture * AsyncReplyChannel<TestFixtureRunningToken>) list
+    }
+
+    member this.NewTest (tf : TestFixture) (par : Parallelizable<unit> option) (test : unit -> Task) =
+        {
+            MaxParallelism = this.MaxParallelism
+            Waiting = this.Waiting
+            CurrentlyRunning =
+                let found = ref 0
+
+                this.CurrentlyRunning
+                |> List.map (fun f ->
+                    if Object.ReferenceEquals (f.Fixture, tf) then
+                        Interlocked.Increment found |> ignore<int>
+
+                        { f with
+                            Waiting = (test, par) :: f.Waiting
+                        }
+                    else
+                        f
+                )
+                |> fun l ->
+                    match found.Value with
+                    | 1 -> l
+                    | 0 -> failwith $"Unexpectedly did not find the running test fixture '%s{tf.Name}' to add a test to"
+                    | _ -> failwith $"Unexpectedly found the running test fixture '%s{tf.Name}' multiple times in list"
+        }
+
+    member this.CompleteFixture (tf : TestFixture) : RunningState =
+        let rec go (acc : RunningFixture list) (running : RunningFixture list) =
+            match running with
+            | [] -> failwith "Caller has somehow called EndTestFixture while we're not running that test fixture"
+            | runningFixture :: tail ->
+                if Object.ReferenceEquals (runningFixture.Fixture, tf) then
+                    match runningFixture.Running, runningFixture.Waiting with
+                    | [], [] -> acc @ tail
+                    | r, [] ->
+                        failwith $"Caller has called EndTestFixture while its tests are still running (%i{r.Length})"
+                    | [], r ->
+                        failwith $"Caller has called EndTestFixture while it has tests waiting to run (%i{r.Length})"
+                    | r, s ->
+                        failwith
+                            $"Caller has called EndTestFixture while it has tests waiting to run (%i{s.Length}) and test running (%i{r.Length})"
+                else
+                    go (runningFixture :: acc) tail
+
+        let currentlyRunning = go [] this.CurrentlyRunning
+
+        {
+            CurrentlyRunning = currentlyRunning
+            Waiting = this.Waiting
+            MaxParallelism = this.MaxParallelism
+        }
+
+type private MailboxState =
+    | Idle
+    | Running of RunningState
+
+/// Run some things in parallel.
+/// TODO: actually implement the parallelism! Right now this just runs everything serially.
+/// TODO: consume the cancellation token
+type ParallelQueue
+    (parallelism : int option, _scope : Parallelizable<AssemblyParallelScope> option, ?ct : CancellationToken)
+    =
+    let parallelism =
+        match parallelism with
+        | None -> max (Environment.ProcessorCount / 2) 2
+        | Some p -> p
+
+    let rec processTask (state : MailboxState) (m : MailboxProcessor<MailboxMessage>) =
+        async {
+            let! message = m.Receive ()
+
+            match message with
+            | MailboxMessage.Quit rc -> rc.Reply ()
+            | MailboxMessage.Reconcile ->
+                match state with
+                | Idle -> return! processTask state m
+                | Running r ->
+
+                match r.CurrentlyRunning with
+                | [] ->
+                    match r.Waiting with
+                    | [] -> return! processTask Idle m
+                    | (head, rc) :: tail ->
+                        rc.Reply (TestFixtureRunningToken head)
+
+                        let newRunning =
+                            {
+                                Fixture = head
+                                Running = []
+                                RunningCanParallelize = true
+                                Waiting = []
+                            }
+
+                        let state =
+                            {
+                                MaxParallelism = r.MaxParallelism
+                                CurrentlyRunning = [ newRunning ]
+                                Waiting = tail
+                            }
+                        // For now, we'll just run one fixture at a time. When we run multiple fixtures in parallel,
+                        // we probably want to call Reconcile here again.
+                        return! processTask (Running state) m
+                | [ currentlyRunning ] ->
+                    let currentlyRunningTasks =
+                        currentlyRunning.Running |> List.filter (fun t -> not t.IsCompleted)
+
+                    let r =
+                        { r with
+                            CurrentlyRunning =
+                                [
+                                    { currentlyRunning with
+                                        Running = currentlyRunningTasks
+                                    }
+                                ]
+                        }
+
+                    match currentlyRunningTasks with
+                    | [] ->
+                        match currentlyRunning.Waiting with
+                        | [] ->
+                            // Nothing to run yet
+                            return! processTask (Running r) m
+                        | (head, par) :: tail ->
+                            let par =
+                                match par with
+                                | None -> true
+                                | Some Parallelizable.No -> false
+                                | Some (Parallelizable.Yes ()) -> true
+
+                            let state =
+                                {
+                                    Fixture = currentlyRunning.Fixture
+                                    RunningCanParallelize = par
+                                    Waiting = tail
+                                    Running = [ head () ]
+                                }
+
+                            m.Post MailboxMessage.Reconcile
+
+                            return!
+                                processTask
+                                    (Running
+                                        { r with
+                                            CurrentlyRunning = [ state ]
+                                        })
+                                    m
+
+                    | currentlyRunningTasks ->
+
+                    if currentlyRunningTasks.Length >= parallelism then
+                        return! processTask (Running r) m
+                    else
+
+                    match currentlyRunning.Waiting, currentlyRunning.RunningCanParallelize with
+                    | [], _ ->
+                        // No new candidates.
+                        return! processTask (Running r) m
+                    | _, false ->
+                        // The running test(s) can't have others added.
+                        return! processTask (Running r) m
+                    | (head, par) :: tail, true ->
+                        match par with
+                        | Some Parallelizable.No -> return! processTask (Running r) m
+                        | Some (Parallelizable.Yes ()) ->
+                            let state =
+                                {
+                                    RunningState.MaxParallelism = r.MaxParallelism
+                                    Waiting = r.Waiting
+                                    CurrentlyRunning =
+                                        [
+                                            {
+                                                Fixture = currentlyRunning.Fixture
+                                                RunningCanParallelize = true
+                                                Running = head () :: currentlyRunning.Running
+                                                Waiting = tail
+                                            }
+                                        ]
+                                }
+
+                            m.Post MailboxMessage.Reconcile
+                            return! processTask (Running state) m
+                        | None ->
+                            match currentlyRunning.Fixture.Parallelize with
+                            | Some Parallelizable.No
+                            | Some (Parallelizable.Yes ClassParallelScope.Self)
+                            | Some (Parallelizable.Yes ClassParallelScope.Fixtures) ->
+                                // Can't add this test to the parallel queue right now
+                                return! processTask (Running r) m
+                            | None
+                            | Some (Parallelizable.Yes ClassParallelScope.All)
+                            | Some (Parallelizable.Yes ClassParallelScope.Children) ->
+                                let state =
+                                    {
+                                        Fixture = currentlyRunning.Fixture
+                                        RunningCanParallelize = true
+                                        Waiting = tail
+                                        Running = (head ()) :: currentlyRunningTasks
+                                    }
+
+                                m.Post MailboxMessage.Reconcile
+
+                                return!
+                                    processTask
+                                        (Running
+                                            { r with
+                                                CurrentlyRunning = [ state ]
+                                            })
+                                        m
+                | _ -> failwith "Logic error: we currently only run one fixture at a time"
+            | MailboxMessage.BeginTestFixture (tf, rc) ->
+                match state with
+                | Running state ->
+                    let state =
+                        {
+                            MaxParallelism = state.MaxParallelism
+                            CurrentlyRunning = state.CurrentlyRunning
+                            Waiting = (tf, rc) :: state.Waiting
+                        }
+                        |> Running
+
+                    m.Post MailboxMessage.Reconcile
+                    return! processTask state m
+                | Idle ->
+                    let state =
+                        {
+                            MaxParallelism = parallelism
+                            CurrentlyRunning = []
+                            Waiting = [ (tf, rc) ]
+                        }
+                        |> Running
+
+                    m.Post MailboxMessage.Reconcile
+                    return! processTask state m
+            | MailboxMessage.EndTestFixture (TestFixtureTearDownToken tf, rc) ->
+                match state with
+                | Idle ->
+                    return failwith "Caller has somehow called EndTestFixture while we're not running a test fixture"
+                | Running state ->
+                    let state = state.CompleteFixture tf
+                    rc.Reply ()
+                    m.Post MailboxMessage.Reconcile
+                    return! processTask (Running state) m
+            | MailboxMessage.RunTest (withinFixture, par, message) ->
+                let t () =
+                    { new ThunkEvaluator<_> with
+                        member _.Eval<'b> (t : unit -> 'b) rc =
+                            let tcs = TaskCompletionSource ()
+                            use ec = ExecutionContext.Capture ()
+
+                            fun () ->
+                                ExecutionContext.Run (
+                                    ec,
+                                    (fun _ ->
+                                        let result = t ()
+                                        tcs.SetResult ()
+                                        m.Post MailboxMessage.Reconcile
+                                        rc.Reply result
+                                    ),
+                                    ()
+                                )
+                            |> Task.Factory.StartNew
+                            |> ignore<Task>
+
+                            tcs.Task
+                    }
+                    |> message.Apply
+
+                let state =
+                    match state with
+                    | Idle -> failwith "somehow asked the queue to run tests when there is no active fixture"
+                    | Running state -> state.NewTest withinFixture par t |> Running
+
+                m.Post MailboxMessage.Reconcile
+
+                return! processTask state m
+        }
+
+    let mb = new MailboxProcessor<_> (processTask MailboxState.Idle)
+    do mb.Start ()
+
+    /// Request to run the given action, freely in parallel with other running tests.
+    /// The resulting Task will return when the action has completed.
+    member _.Run<'a>
+        (TestFixtureSetupToken parent)
+        (scope : Parallelizable<unit> option)
+        (action : unit -> 'a)
+        : 'a Task
+        =
+        (fun rc -> MailboxMessage.RunTest (parent, scope, ThunkCrate.make action rc))
+        |> mb.PostAndAsyncReply
+        |> Async.StartAsTask
+
+    /// Declare that we wish to start the given test fixture. The resulting Task will return
+    /// when you are allowed to start running tests from that fixture.
+    /// Once you've finished running tests from that fixture, call EndTestFixture.
+    member _.StartTestFixture (tf : TestFixture) : Task<TestFixtureRunningToken> =
+        fun rc -> MailboxMessage.BeginTestFixture (tf, rc)
+        |> mb.PostAndAsyncReply
+        |> Async.StartAsTask
+
+    /// Run the given one-time setup for the test fixture.
+    member _.RunTestSetup (TestFixtureRunningToken parent) (action : unit -> 'a) : ('a * TestFixtureSetupToken) Task =
+        task {
+            let par =
+                parent.Parallelize
+                |> Option.map (fun p ->
+                    match p with
+                    | Parallelizable.No -> Parallelizable.No
+                    | Parallelizable.Yes _ -> Parallelizable.Yes ()
+                )
+
+            let! response =
+                (fun rc -> MailboxMessage.RunTest (parent, par, ThunkCrate.make action rc))
+                |> mb.PostAndAsyncReply
+
+            return response, TestFixtureSetupToken parent
+        }
+
+    /// Run the given one-time tear-down for the test fixture.
+    member _.RunTestTearDown
+        (TestFixtureSetupToken parent)
+        (action : unit -> 'a)
+        : ('a * TestFixtureTearDownToken) Task
+        =
+        task {
+            let par =
+                parent.Parallelize
+                |> Option.map (fun p ->
+                    match p with
+                    | Parallelizable.No -> Parallelizable.No
+                    | Parallelizable.Yes _ -> Parallelizable.Yes ()
+                )
+
+            let! response =
+                (fun rc -> MailboxMessage.RunTest (parent, par, ThunkCrate.make action rc))
+                |> mb.PostAndAsyncReply
+
+            return response, TestFixtureTearDownToken parent
+        }
+
+    /// Declare that we have finished submitting requests to run in the given test fixture.
+    /// You don't need to worry about when the resulting Task returns, but we provide it just in case.
+    member _.EndTestFixture (tf : TestFixtureTearDownToken) : Task<unit> =
+        (fun rc -> MailboxMessage.EndTestFixture (tf, rc))
+        |> mb.PostAndAsyncReply
+        |> Async.StartAsTask
+
+    interface IDisposable with
+        member _.Dispose () =
+            // Still race conditions, of course: people could still be submitting after we finish the sync.
+            mb.PostAndReply MailboxMessage.Quit
+            (mb :> IDisposable).Dispose ()

WoofWare.NUnitTestRunner.Lib/SingleTestMethod.fs

@@ -18,15 +18,15 @@ module SingleTestMethod =
         (attrs : CustomAttributeData list)
         : SingleTestMethod option * CustomAttributeData list
         =
-        let remaining, isTest, sources, hasData, modifiers, categories, repeat, comb =
-            (([], false, [], None, [], [], None, None), attrs)
-            ||> List.fold (fun (remaining, isTest, sources, hasData, mods, cats, repeat, comb) attr ->
+        let remaining, isTest, sources, hasData, modifiers, categories, repeat, comb, par =
+            (([], false, [], None, [], [], None, None, None), attrs)
+            ||> List.fold (fun (remaining, isTest, sources, hasData, mods, cats, repeat, comb, par) attr ->
                 match attr.AttributeType.FullName with
                 | "NUnit.Framework.TestAttribute" ->
                     if attr.ConstructorArguments.Count > 0 then
                         failwith "Unexpectedly got arguments to the Test attribute"
 
-                    (remaining, true, sources, hasData, mods, cats, repeat, comb)
+                    (remaining, true, sources, hasData, mods, cats, repeat, comb, par)
                 | "NUnit.Framework.TestCaseAttribute" ->
                     let args = attr.ConstructorArguments |> Seq.map _.Value |> Seq.toList
 
@@ -40,62 +40,73 @@ module SingleTestMethod =
                         | _ -> args
 
                     match hasData with
-                    | None -> (remaining, isTest, sources, Some [ List.ofSeq args ], mods, cats, repeat, comb)
+                    | None -> (remaining, isTest, sources, Some [ List.ofSeq args ], mods, cats, repeat, comb, par)
                     | Some existing ->
-                        (remaining, isTest, sources, Some ((List.ofSeq args) :: existing), mods, cats, repeat, comb)
+                        let args = (List.ofSeq args) :: existing |> Some
+                        (remaining, isTest, sources, args, mods, cats, repeat, comb, par)
                 | "NUnit.Framework.TestCaseSourceAttribute" ->
                     let arg = attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox<string>
 
-                    (remaining, isTest, arg :: sources, hasData, mods, cats, repeat, comb)
+                    (remaining, isTest, arg :: sources, hasData, mods, cats, repeat, comb, par)
                 | "NUnit.Framework.ExplicitAttribute" ->
                     let reason =
                         attr.ConstructorArguments
                         |> Seq.tryHead
                         |> Option.map (_.Value >> unbox<string>)
 
-                    (remaining, isTest, sources, hasData, (Modifier.Explicit reason) :: mods, cats, repeat, comb)
+                    (remaining, isTest, sources, hasData, (Modifier.Explicit reason) :: mods, cats, repeat, comb, par)
                 | "NUnit.Framework.IgnoreAttribute" ->
                     let reason =
                         attr.ConstructorArguments
                         |> Seq.tryHead
                         |> Option.map (_.Value >> unbox<string>)
 
-                    (remaining, isTest, sources, hasData, (Modifier.Ignored reason) :: mods, cats, repeat, comb)
+                    (remaining, isTest, sources, hasData, (Modifier.Ignored reason) :: mods, cats, repeat, comb, par)
                 | "NUnit.Framework.CategoryAttribute" ->
                     let category =
                         attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox<string>
 
-                    (remaining, isTest, sources, hasData, mods, category :: cats, repeat, comb)
+                    (remaining, isTest, sources, hasData, mods, category :: cats, repeat, comb, par)
                 | "NUnit.Framework.RepeatAttribute" ->
                     match repeat with
                     | Some _ -> failwith $"Got RepeatAttribute multiple times on %s{method.Name}"
                     | None ->
 
                     let repeat = attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox<int>
-                    (remaining, isTest, sources, hasData, mods, cats, Some repeat, comb)
+                    (remaining, isTest, sources, hasData, mods, cats, Some repeat, comb, par)
                 | "NUnit.Framework.CombinatorialAttribute" ->
                     match comb with
                     | Some _ ->
                         failwith $"Got CombinatorialAttribute or SequentialAttribute multiple times on %s{method.Name}"
                     | None ->
-                        (remaining, isTest, sources, hasData, mods, cats, repeat, Some Combinatorial.Combinatorial)
+                        (remaining, isTest, sources, hasData, mods, cats, repeat, Some Combinatorial.Combinatorial, par)
                 | "NUnit.Framework.SequentialAttribute" ->
                     match comb with
                     | Some _ ->
                         failwith $"Got CombinatorialAttribute or SequentialAttribute multiple times on %s{method.Name}"
-                    | None -> (remaining, isTest, sources, hasData, mods, cats, repeat, Some Combinatorial.Sequential)
+                    | None ->
+                        (remaining, isTest, sources, hasData, mods, cats, repeat, Some Combinatorial.Sequential, par)
+                | "NUnit.Framework.NonParallelizableAttribute" ->
+                    match par with
+                    | Some _ -> failwith $"Got a parallelization attribute multiple times on %s{method.Name}"
+                    | None -> (remaining, isTest, sources, hasData, mods, cats, repeat, comb, Some Parallelizable.No)
+                | "NUnit.Framework.ParallelizableAttribute" ->
+                    match par with
+                    | Some _ -> failwith $"Got multiple parallelization attributes on %s{method.Name}"
+                    | None ->
+                        (remaining, isTest, sources, hasData, mods, cats, repeat, comb, Some (Parallelizable.Yes ()))
                 | s when s.StartsWith ("NUnit.Framework", StringComparison.Ordinal) ->
                     failwith $"Unrecognised attribute on function %s{method.Name}: %s{attr.AttributeType.FullName}"
-                | _ -> (attr :: remaining, isTest, sources, hasData, mods, cats, repeat, comb)
+                | _ -> (attr :: remaining, isTest, sources, hasData, mods, cats, repeat, comb, par)
             )
 
         let test =
-            match isTest, sources, hasData, modifiers, categories, repeat, comb with
-            | _, _ :: _, Some _, _, _, _, _ ->
+            match isTest, sources, hasData, modifiers, categories, repeat, comb, par with
+            | _, _ :: _, Some _, _, _, _, _, _ ->
                 failwith
                     $"Test '%s{method.Name}' unexpectedly has both TestData and TestCaseSource; not currently supported"
-            | false, [], None, [], _, _, _ -> None
-            | _, _ :: _, None, mods, categories, repeat, comb ->
+            | false, [], None, [], _, _, _, _ -> None
+            | _, _ :: _, None, mods, categories, repeat, comb, par ->
                 {
                     Kind = TestKind.Source sources
                     Method = method
@@ -103,9 +114,10 @@ module SingleTestMethod =
                     Categories = categories @ parentCategories
                     Repeat = repeat
                     Combinatorial = comb
+                    Parallelize = par
                 }
                 |> Some
-            | _, [], Some data, mods, categories, repeat, comb ->
+            | _, [], Some data, mods, categories, repeat, comb, par ->
                 {
                     Kind = TestKind.Data data
                     Method = method
@@ -113,9 +125,10 @@ module SingleTestMethod =
                     Categories = categories @ parentCategories
                     Repeat = repeat
                     Combinatorial = comb
+                    Parallelize = par
                 }
                 |> Some
-            | true, [], None, mods, categories, repeat, comb ->
+            | true, [], None, mods, categories, repeat, comb, par ->
                 {
                     Kind = TestKind.Single
                     Method = method
@@ -123,9 +136,10 @@ module SingleTestMethod =
                     Categories = categories @ parentCategories
                     Repeat = repeat
                     Combinatorial = comb
+                    Parallelize = par
                 }
                 |> Some
-            | false, [], None, _ :: _, _, _, _ ->
+            | false, [], None, _ :: _, _, _, _, _ ->
                 failwith
                     $"Unexpectedly got test modifiers but no test settings on '%s{method.Name}', which you probably didn't intend."
 

WoofWare.NUnitTestRunner.Lib/SurfaceBaseline.txt

@@ -1,3 +1,41 @@
+WoofWare.NUnitTestRunner.AssemblyParallelScope inherit obj, implements WoofWare.NUnitTestRunner.AssemblyParallelScope System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.NUnitTestRunner.AssemblyParallelScope System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 2 cases
+WoofWare.NUnitTestRunner.AssemblyParallelScope+Tags inherit obj
+WoofWare.NUnitTestRunner.AssemblyParallelScope+Tags.Children [static field]: int = 0
+WoofWare.NUnitTestRunner.AssemblyParallelScope+Tags.Fixtures [static field]: int = 1
+WoofWare.NUnitTestRunner.AssemblyParallelScope.Children [static property]: [read-only] WoofWare.NUnitTestRunner.AssemblyParallelScope
+WoofWare.NUnitTestRunner.AssemblyParallelScope.Fixtures [static property]: [read-only] WoofWare.NUnitTestRunner.AssemblyParallelScope
+WoofWare.NUnitTestRunner.AssemblyParallelScope.get_Children [static method]: unit -> WoofWare.NUnitTestRunner.AssemblyParallelScope
+WoofWare.NUnitTestRunner.AssemblyParallelScope.get_Fixtures [static method]: unit -> WoofWare.NUnitTestRunner.AssemblyParallelScope
+WoofWare.NUnitTestRunner.AssemblyParallelScope.get_IsChildren [method]: unit -> bool
+WoofWare.NUnitTestRunner.AssemblyParallelScope.get_IsFixtures [method]: unit -> bool
+WoofWare.NUnitTestRunner.AssemblyParallelScope.get_Tag [method]: unit -> int
+WoofWare.NUnitTestRunner.AssemblyParallelScope.IsChildren [property]: [read-only] bool
+WoofWare.NUnitTestRunner.AssemblyParallelScope.IsFixtures [property]: [read-only] bool
+WoofWare.NUnitTestRunner.AssemblyParallelScope.Tag [property]: [read-only] int
+WoofWare.NUnitTestRunner.ClassParallelScope inherit obj, implements WoofWare.NUnitTestRunner.ClassParallelScope System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.NUnitTestRunner.ClassParallelScope System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 4 cases
+WoofWare.NUnitTestRunner.ClassParallelScope+Tags inherit obj
+WoofWare.NUnitTestRunner.ClassParallelScope+Tags.All [static field]: int = 3
+WoofWare.NUnitTestRunner.ClassParallelScope+Tags.Children [static field]: int = 1
+WoofWare.NUnitTestRunner.ClassParallelScope+Tags.Fixtures [static field]: int = 2
+WoofWare.NUnitTestRunner.ClassParallelScope+Tags.Self [static field]: int = 0
+WoofWare.NUnitTestRunner.ClassParallelScope.All [static property]: [read-only] WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.Children [static property]: [read-only] WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.Fixtures [static property]: [read-only] WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.get_All [static method]: unit -> WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.get_Children [static method]: unit -> WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.get_Fixtures [static method]: unit -> WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.get_IsAll [method]: unit -> bool
+WoofWare.NUnitTestRunner.ClassParallelScope.get_IsChildren [method]: unit -> bool
+WoofWare.NUnitTestRunner.ClassParallelScope.get_IsFixtures [method]: unit -> bool
+WoofWare.NUnitTestRunner.ClassParallelScope.get_IsSelf [method]: unit -> bool
+WoofWare.NUnitTestRunner.ClassParallelScope.get_Self [static method]: unit -> WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.get_Tag [method]: unit -> int
+WoofWare.NUnitTestRunner.ClassParallelScope.IsAll [property]: [read-only] bool
+WoofWare.NUnitTestRunner.ClassParallelScope.IsChildren [property]: [read-only] bool
+WoofWare.NUnitTestRunner.ClassParallelScope.IsFixtures [property]: [read-only] bool
+WoofWare.NUnitTestRunner.ClassParallelScope.IsSelf [property]: [read-only] bool
+WoofWare.NUnitTestRunner.ClassParallelScope.Self [static property]: [read-only] WoofWare.NUnitTestRunner.ClassParallelScope
+WoofWare.NUnitTestRunner.ClassParallelScope.Tag [property]: [read-only] int
 WoofWare.NUnitTestRunner.Combinatorial inherit obj, implements WoofWare.NUnitTestRunner.Combinatorial System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.NUnitTestRunner.Combinatorial System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 2 cases
 WoofWare.NUnitTestRunner.Combinatorial+Tags inherit obj
 WoofWare.NUnitTestRunner.Combinatorial+Tags.Combinatorial [static field]: int = 0
@@ -105,6 +143,8 @@ WoofWare.NUnitTestRunner.ITestProgress.OnTestFixtureStart [method]: string -> in
 WoofWare.NUnitTestRunner.ITestProgress.OnTestMemberFinished [method]: string -> unit
 WoofWare.NUnitTestRunner.ITestProgress.OnTestMemberSkipped [method]: string -> unit
 WoofWare.NUnitTestRunner.ITestProgress.OnTestMemberStart [method]: string -> unit
+WoofWare.NUnitTestRunner.LoadContext inherit System.Runtime.Loader.AssemblyLoadContext
+WoofWare.NUnitTestRunner.LoadContext..ctor [constructor]: (System.IO.FileInfo, System.IO.DirectoryInfo list, WoofWare.NUnitTestRunner.TestContexts)
 WoofWare.NUnitTestRunner.Match inherit obj, implements WoofWare.NUnitTestRunner.Match System.IEquatable, System.Collections.IStructuralEquatable, WoofWare.NUnitTestRunner.Match System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 2 cases
 WoofWare.NUnitTestRunner.Match+Contains inherit WoofWare.NUnitTestRunner.Match
 WoofWare.NUnitTestRunner.Match+Contains.get_Item [method]: unit -> string
@@ -141,8 +181,31 @@ WoofWare.NUnitTestRunner.Modifier.IsIgnored [property]: [read-only] bool
 WoofWare.NUnitTestRunner.Modifier.NewExplicit [static method]: string option -> WoofWare.NUnitTestRunner.Modifier
 WoofWare.NUnitTestRunner.Modifier.NewIgnored [static method]: string option -> WoofWare.NUnitTestRunner.Modifier
 WoofWare.NUnitTestRunner.Modifier.Tag [property]: [read-only] int
+WoofWare.NUnitTestRunner.Parallelizable`1 inherit obj, implements 'scope WoofWare.NUnitTestRunner.Parallelizable System.IEquatable, System.Collections.IStructuralEquatable, 'scope WoofWare.NUnitTestRunner.Parallelizable System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 2 cases
+WoofWare.NUnitTestRunner.Parallelizable`1+Tags inherit obj
+WoofWare.NUnitTestRunner.Parallelizable`1+Tags.No [static field]: int = 1
+WoofWare.NUnitTestRunner.Parallelizable`1+Tags.Yes [static field]: int = 0
+WoofWare.NUnitTestRunner.Parallelizable`1+Yes inherit 'scope WoofWare.NUnitTestRunner.Parallelizable
+WoofWare.NUnitTestRunner.Parallelizable`1+Yes.get_Item [method]: unit -> 'scope
+WoofWare.NUnitTestRunner.Parallelizable`1+Yes.Item [property]: [read-only] 'scope
+WoofWare.NUnitTestRunner.Parallelizable`1.get_IsNo [method]: unit -> bool
+WoofWare.NUnitTestRunner.Parallelizable`1.get_IsYes [method]: unit -> bool
+WoofWare.NUnitTestRunner.Parallelizable`1.get_No [static method]: unit -> 'scope WoofWare.NUnitTestRunner.Parallelizable
+WoofWare.NUnitTestRunner.Parallelizable`1.get_Tag [method]: unit -> int
+WoofWare.NUnitTestRunner.Parallelizable`1.IsNo [property]: [read-only] bool
+WoofWare.NUnitTestRunner.Parallelizable`1.IsYes [property]: [read-only] bool
+WoofWare.NUnitTestRunner.Parallelizable`1.NewYes [static method]: 'scope -> 'scope WoofWare.NUnitTestRunner.Parallelizable
+WoofWare.NUnitTestRunner.Parallelizable`1.No [static property]: [read-only] 'scope WoofWare.NUnitTestRunner.Parallelizable
+WoofWare.NUnitTestRunner.Parallelizable`1.Tag [property]: [read-only] int
+WoofWare.NUnitTestRunner.ParallelQueue inherit obj, implements IDisposable
+WoofWare.NUnitTestRunner.ParallelQueue..ctor [constructor]: (int option, WoofWare.NUnitTestRunner.AssemblyParallelScope WoofWare.NUnitTestRunner.Parallelizable option, System.Threading.CancellationToken option)
+WoofWare.NUnitTestRunner.ParallelQueue.EndTestFixture [method]: WoofWare.NUnitTestRunner.TestFixtureTearDownToken -> unit System.Threading.Tasks.Task
+WoofWare.NUnitTestRunner.ParallelQueue.Run [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> unit WoofWare.NUnitTestRunner.Parallelizable option -> (unit -> 'a) -> 'a System.Threading.Tasks.Task
+WoofWare.NUnitTestRunner.ParallelQueue.RunTestSetup [method]: WoofWare.NUnitTestRunner.TestFixtureRunningToken -> (unit -> 'a) -> ('a * WoofWare.NUnitTestRunner.TestFixtureSetupToken) System.Threading.Tasks.Task
+WoofWare.NUnitTestRunner.ParallelQueue.RunTestTearDown [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> (unit -> 'a) -> ('a * WoofWare.NUnitTestRunner.TestFixtureTearDownToken) System.Threading.Tasks.Task
+WoofWare.NUnitTestRunner.ParallelQueue.StartTestFixture [method]: WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.TestFixtureRunningToken System.Threading.Tasks.Task
 WoofWare.NUnitTestRunner.SingleTestMethod inherit obj, implements WoofWare.NUnitTestRunner.SingleTestMethod System.IEquatable, System.Collections.IStructuralEquatable
-WoofWare.NUnitTestRunner.SingleTestMethod..ctor [constructor]: (System.Reflection.MethodInfo, WoofWare.NUnitTestRunner.TestKind, WoofWare.NUnitTestRunner.Modifier list, string list, int option, WoofWare.NUnitTestRunner.Combinatorial option)
+WoofWare.NUnitTestRunner.SingleTestMethod..ctor [constructor]: (System.Reflection.MethodInfo, WoofWare.NUnitTestRunner.TestKind, WoofWare.NUnitTestRunner.Modifier list, string list, int option, WoofWare.NUnitTestRunner.Combinatorial option, unit WoofWare.NUnitTestRunner.Parallelizable option)
 WoofWare.NUnitTestRunner.SingleTestMethod.Categories [property]: [read-only] string list
 WoofWare.NUnitTestRunner.SingleTestMethod.Combinatorial [property]: [read-only] WoofWare.NUnitTestRunner.Combinatorial option
 WoofWare.NUnitTestRunner.SingleTestMethod.get_Categories [method]: unit -> string list
@@ -151,14 +214,18 @@ WoofWare.NUnitTestRunner.SingleTestMethod.get_Kind [method]: unit -> WoofWare.NU
 WoofWare.NUnitTestRunner.SingleTestMethod.get_Method [method]: unit -> System.Reflection.MethodInfo
 WoofWare.NUnitTestRunner.SingleTestMethod.get_Modifiers [method]: unit -> WoofWare.NUnitTestRunner.Modifier list
 WoofWare.NUnitTestRunner.SingleTestMethod.get_Name [method]: unit -> string
+WoofWare.NUnitTestRunner.SingleTestMethod.get_Parallelize [method]: unit -> unit WoofWare.NUnitTestRunner.Parallelizable option
 WoofWare.NUnitTestRunner.SingleTestMethod.get_Repeat [method]: unit -> int option
 WoofWare.NUnitTestRunner.SingleTestMethod.Kind [property]: [read-only] WoofWare.NUnitTestRunner.TestKind
 WoofWare.NUnitTestRunner.SingleTestMethod.Method [property]: [read-only] System.Reflection.MethodInfo
 WoofWare.NUnitTestRunner.SingleTestMethod.Modifiers [property]: [read-only] WoofWare.NUnitTestRunner.Modifier list
 WoofWare.NUnitTestRunner.SingleTestMethod.Name [property]: [read-only] string
+WoofWare.NUnitTestRunner.SingleTestMethod.Parallelize [property]: [read-only] unit WoofWare.NUnitTestRunner.Parallelizable option
 WoofWare.NUnitTestRunner.SingleTestMethod.Repeat [property]: [read-only] int option
 WoofWare.NUnitTestRunner.SingleTestMethodModule inherit obj
 WoofWare.NUnitTestRunner.SingleTestMethodModule.parse [static method]: string list -> System.Reflection.MethodInfo -> System.Reflection.CustomAttributeData list -> (WoofWare.NUnitTestRunner.SingleTestMethod option * System.Reflection.CustomAttributeData list)
+WoofWare.NUnitTestRunner.TestContexts inherit obj, implements WoofWare.NUnitTestRunner.TestContexts System.IEquatable, System.Collections.IStructuralEquatable, IDisposable
+WoofWare.NUnitTestRunner.TestContexts.Empty [static method]: unit -> WoofWare.NUnitTestRunner.TestContexts
 WoofWare.NUnitTestRunner.TestFailure inherit obj, implements WoofWare.NUnitTestRunner.TestFailure System.IEquatable, System.Collections.IStructuralEquatable - union type with 3 cases
 WoofWare.NUnitTestRunner.TestFailure+SetUpFailed inherit WoofWare.NUnitTestRunner.TestFailure
 WoofWare.NUnitTestRunner.TestFailure+SetUpFailed.get_Item [method]: unit -> WoofWare.NUnitTestRunner.UserMethodFailure
@@ -187,13 +254,14 @@ WoofWare.NUnitTestRunner.TestFailure.NewTearDownFailed [static method]: WoofWare
 WoofWare.NUnitTestRunner.TestFailure.NewTestFailed [static method]: WoofWare.NUnitTestRunner.UserMethodFailure -> WoofWare.NUnitTestRunner.TestFailure
 WoofWare.NUnitTestRunner.TestFailure.Tag [property]: [read-only] int
 WoofWare.NUnitTestRunner.TestFixture inherit obj, implements WoofWare.NUnitTestRunner.TestFixture System.IEquatable, System.Collections.IStructuralEquatable
-WoofWare.NUnitTestRunner.TestFixture..ctor [constructor]: (System.Reflection.Assembly, string, System.Type, System.Reflection.MethodInfo option, System.Reflection.MethodInfo option, System.Reflection.MethodInfo list, System.Reflection.MethodInfo list, obj list list, WoofWare.NUnitTestRunner.SingleTestMethod list)
+WoofWare.NUnitTestRunner.TestFixture..ctor [constructor]: (System.Reflection.Assembly, string, System.Type, System.Reflection.MethodInfo option, System.Reflection.MethodInfo option, System.Reflection.MethodInfo list, System.Reflection.MethodInfo list, obj list list, WoofWare.NUnitTestRunner.SingleTestMethod list, WoofWare.NUnitTestRunner.ClassParallelScope WoofWare.NUnitTestRunner.Parallelizable option)
 WoofWare.NUnitTestRunner.TestFixture.ContainingAssembly [property]: [read-only] System.Reflection.Assembly
-WoofWare.NUnitTestRunner.TestFixture.Empty [static method]: System.Type -> obj list list -> WoofWare.NUnitTestRunner.TestFixture
+WoofWare.NUnitTestRunner.TestFixture.Empty [static method]: System.Type -> WoofWare.NUnitTestRunner.ClassParallelScope WoofWare.NUnitTestRunner.Parallelizable option -> obj list list -> WoofWare.NUnitTestRunner.TestFixture
 WoofWare.NUnitTestRunner.TestFixture.get_ContainingAssembly [method]: unit -> System.Reflection.Assembly
 WoofWare.NUnitTestRunner.TestFixture.get_Name [method]: unit -> string
 WoofWare.NUnitTestRunner.TestFixture.get_OneTimeSetUp [method]: unit -> System.Reflection.MethodInfo option
 WoofWare.NUnitTestRunner.TestFixture.get_OneTimeTearDown [method]: unit -> System.Reflection.MethodInfo option
+WoofWare.NUnitTestRunner.TestFixture.get_Parallelize [method]: unit -> WoofWare.NUnitTestRunner.ClassParallelScope WoofWare.NUnitTestRunner.Parallelizable option
 WoofWare.NUnitTestRunner.TestFixture.get_Parameters [method]: unit -> obj list list
 WoofWare.NUnitTestRunner.TestFixture.get_SetUp [method]: unit -> System.Reflection.MethodInfo list
 WoofWare.NUnitTestRunner.TestFixture.get_TearDown [method]: unit -> System.Reflection.MethodInfo list
@@ -202,6 +270,7 @@ WoofWare.NUnitTestRunner.TestFixture.get_Type [method]: unit -> System.Type
 WoofWare.NUnitTestRunner.TestFixture.Name [property]: [read-only] string
 WoofWare.NUnitTestRunner.TestFixture.OneTimeSetUp [property]: [read-only] System.Reflection.MethodInfo option
 WoofWare.NUnitTestRunner.TestFixture.OneTimeTearDown [property]: [read-only] System.Reflection.MethodInfo option
+WoofWare.NUnitTestRunner.TestFixture.Parallelize [property]: [read-only] WoofWare.NUnitTestRunner.ClassParallelScope WoofWare.NUnitTestRunner.Parallelizable option
 WoofWare.NUnitTestRunner.TestFixture.Parameters [property]: [read-only] obj list list
 WoofWare.NUnitTestRunner.TestFixture.SetUp [property]: [read-only] System.Reflection.MethodInfo list
 WoofWare.NUnitTestRunner.TestFixture.TearDown [property]: [read-only] System.Reflection.MethodInfo list
@@ -209,7 +278,11 @@ WoofWare.NUnitTestRunner.TestFixture.Tests [property]: [read-only] WoofWare.NUni
 WoofWare.NUnitTestRunner.TestFixture.Type [property]: [read-only] System.Type
 WoofWare.NUnitTestRunner.TestFixtureModule inherit obj
 WoofWare.NUnitTestRunner.TestFixtureModule.parse [static method]: System.Type -> WoofWare.NUnitTestRunner.TestFixture
-WoofWare.NUnitTestRunner.TestFixtureModule.run [static method]: WoofWare.NUnitTestRunner.ITestProgress -> (WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.SingleTestMethod -> bool) -> WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.FixtureRunResults list
+WoofWare.NUnitTestRunner.TestFixtureModule.run [static method]: WoofWare.NUnitTestRunner.TestContexts -> WoofWare.NUnitTestRunner.ParallelQueue -> WoofWare.NUnitTestRunner.ITestProgress -> (WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.SingleTestMethod -> bool) -> WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.FixtureRunResults list System.Threading.Tasks.Task
+WoofWare.NUnitTestRunner.TestFixtureModule.runOneFixture [static method]: WoofWare.NUnitTestRunner.TestContexts -> WoofWare.NUnitTestRunner.ParallelQueue -> WoofWare.NUnitTestRunner.ITestProgress -> (WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.SingleTestMethod -> bool) -> string -> obj -> WoofWare.NUnitTestRunner.TestFixture -> WoofWare.NUnitTestRunner.FixtureRunResults System.Threading.Tasks.Task
+WoofWare.NUnitTestRunner.TestFixtureRunningToken inherit obj, implements WoofWare.NUnitTestRunner.TestFixtureRunningToken System.IEquatable, System.Collections.IStructuralEquatable
+WoofWare.NUnitTestRunner.TestFixtureSetupToken inherit obj, implements WoofWare.NUnitTestRunner.TestFixtureSetupToken System.IEquatable, System.Collections.IStructuralEquatable
+WoofWare.NUnitTestRunner.TestFixtureTearDownToken inherit obj, implements WoofWare.NUnitTestRunner.TestFixtureTearDownToken System.IEquatable, System.Collections.IStructuralEquatable
 WoofWare.NUnitTestRunner.TestKind inherit obj, implements WoofWare.NUnitTestRunner.TestKind System.IEquatable, System.Collections.IStructuralEquatable - union type with 3 cases
 WoofWare.NUnitTestRunner.TestKind+Data inherit WoofWare.NUnitTestRunner.TestKind
 WoofWare.NUnitTestRunner.TestKind+Data.get_Item [method]: unit -> obj list list

WoofWare.NUnitTestRunner.Lib/TestFixture.fs

@@ -6,21 +6,9 @@ open System.Diagnostics
 open System.IO
 open System.Reflection
 open System.Threading
+open System.Threading.Tasks
 open Microsoft.FSharp.Core
 
-type private StdoutSetter (newStdout : StreamWriter, newStderr : StreamWriter) =
-    let oldStdout = Console.Out
-    let oldStderr = Console.Error
-
-    do
-        Console.SetOut newStdout
-        Console.SetError newStderr
-
-    interface IDisposable with
-        member _.Dispose () =
-            Console.SetOut oldStdout
-            Console.SetError oldStderr
-
 /// Information about the circumstances of a run of a single test.
 type IndividualTestRunMetadata =
     {
@@ -80,6 +68,8 @@ module TestFixture =
     ///
     /// This function does not throw.
     let private runOne
+        (outputId : OutputStreamId)
+        (contexts : TestContexts)
         (setUp : MethodInfo list)
         (tearDown : MethodInfo list)
         (testId : Guid)
@@ -112,13 +102,6 @@ module TestFixture =
 
         let start = DateTimeOffset.Now
 
-        use stdOutStream = new MemoryStream ()
-        use stdErrStream = new MemoryStream ()
-        use stdOut = new StreamWriter (stdOutStream)
-        use stdErr = new StreamWriter (stdErrStream)
-
-        use _ = new StdoutSetter (stdOut, stdErr)
-
         let sw = Stopwatch.StartNew ()
 
         let metadata () =
@@ -139,13 +122,13 @@ module TestFixture =
                 TestName = name
                 ClassName = test.DeclaringType.FullName
                 StdOut =
-                    match stdOutStream.ToArray () with
-                    | [||] -> None
-                    | arr -> Console.OutputEncoding.GetString arr |> Some
+                    match contexts.DumpStdout outputId with
+                    | "" -> None
+                    | v -> Some v
                 StdErr =
-                    match stdErrStream.ToArray () with
-                    | [||] -> None
-                    | arr -> Console.OutputEncoding.GetString arr |> Some
+                    match contexts.DumpStderr outputId with
+                    | "" -> None
+                    | v -> Some v
             }
 
         let setUpResult = runMethods TestFailure.SetUpFailed setUp [||]
@@ -223,11 +206,15 @@ module TestFixture =
     /// This method should never throw: it only throws if there's a critical logic error in the runner.
     /// Exceptions from the units under test are wrapped up and passed out.
     let private runTestsFromMember
+        (contexts : TestContexts)
+        (par : ParallelQueue)
+        (running : TestFixtureSetupToken)
+        (progress : ITestProgress)
         (setUp : MethodInfo list)
         (tearDown : MethodInfo list)
         (containingObject : obj)
         (test : SingleTestMethod)
-        : (Result<TestMemberSuccess, TestMemberFailure> * IndividualTestRunMetadata) list
+        : (Result<TestMemberSuccess, TestMemberFailure> * IndividualTestRunMetadata) Task list
         =
         if test.Method.ContainsGenericParameters then
             let failureMetadata =
@@ -247,7 +234,7 @@ module TestFixture =
             let error =
                 TestMemberFailure.Malformed [ "Test contained generic parameters; generics are not supported." ]
 
-            (Error error, failureMetadata) |> List.singleton
+            (Error error, failureMetadata) |> Task.FromResult |> List.singleton
         else
 
         let resultPreRun =
@@ -263,17 +250,12 @@ module TestFixture =
                 | Modifier.Ignored reason -> Some (TestMemberSuccess.Ignored reason)
             )
 
-        let sw = Stopwatch.StartNew ()
-        let startTime = DateTimeOffset.Now
-
         match resultPreRun with
         | Some result ->
-            sw.Stop ()
-
             let failureMetadata =
                 {
-                    Total = sw.Elapsed
-                    Start = startTime
+                    Total = TimeSpan.Zero
+                    Start = DateTimeOffset.Now
                     End = DateTimeOffset.Now
                     ComputerName = Environment.MachineName
                     ExecutionId = Guid.NewGuid ()
@@ -285,7 +267,7 @@ module TestFixture =
                     StdOut = None
                 }
 
-            [ Ok result, failureMetadata ]
+            (Ok result, failureMetadata) |> Task.FromResult |> List.singleton
         | None ->
 
         let individualTests =
@@ -348,7 +330,7 @@ module TestFixture =
 
                             // Might not be an IEnumerable of a reference type.
                             // Concretely, `FSharpList<HttpStatusCode> :> IEnumerable<obj>` fails.
-                            for arg in args.GetValue (null : obj) :?> System.Collections.IEnumerable do
+                            for arg in args.GetValue (null : obj) :?> IEnumerable do
                                 yield
                                     Guid.NewGuid (),
                                     match arg with
@@ -371,20 +353,19 @@ module TestFixture =
                                             if isNull argsMem then
                                                 failwith "Unexpectedly could not call `.Arguments` on TestCaseData"
 
+                                            // TODO: need to capture this stdout/stderr
                                             (argsMem.Invoke (arg, [||]) |> unbox<obj[]>)
                                         else
                                             [| arg |]
                     ]
                     |> Ok
 
-        sw.Stop ()
-
         match individualTests with
         | Error e ->
             let failureMetadata =
                 {
-                    Total = sw.Elapsed
-                    Start = startTime
+                    Total = TimeSpan.Zero
+                    Start = DateTimeOffset.Now
                     End = DateTimeOffset.Now
                     ComputerName = Environment.MachineName
                     ExecutionId = Guid.NewGuid ()
@@ -397,7 +378,7 @@ module TestFixture =
                     StdOut = None
                 }
 
-            [ Error e, failureMetadata ]
+            (Error e, failureMetadata) |> Task.FromResult |> List.singleton
         | Ok individualTests ->
 
         let count = test.Repeat |> Option.defaultValue 1
@@ -405,130 +386,219 @@ module TestFixture =
         Seq.init count (fun _ -> individualTests)
         |> Seq.concat
         |> Seq.map (fun (testGuid, args) ->
-            let results, summary =
-                runOne setUp tearDown testGuid test.Method containingObject args
+            task {
+                let runMe () =
+                    progress.OnTestMemberStart test.Name
+                    let oldValue = contexts.AsyncLocal.Value
+                    let outputId = contexts.NewOutputs ()
+                    contexts.AsyncLocal.Value <- outputId
 
-            match results with
-            | Ok results -> Ok results, summary
-            | Error e -> Error (TestMemberFailure.Failed e), summary
+                    let result, meta =
+                        runOne outputId contexts setUp tearDown testGuid test.Method containingObject args
+
+                    contexts.AsyncLocal.Value <- oldValue
+                    progress.OnTestMemberFinished test.Name
+
+                    result, meta
+
+                let! results, summary = par.Run running test.Parallelize runMe
+
+                match results with
+                | Ok results -> return Ok results, summary
+                | Error e -> return Error (TestMemberFailure.Failed e), summary
+            }
         )
         |> Seq.toList
 
     /// Run every test (except those which fail the `filter`) in this test fixture, as well as the
     /// appropriate setup and tear-down logic.
-    let private runOneFixture
+    let runOneFixture
+        (contexts : TestContexts)
+        (par : ParallelQueue)
         (progress : ITestProgress)
         (filter : TestFixture -> SingleTestMethod -> bool)
         (name : string)
         (containingObject : obj)
         (tests : TestFixture)
-        : FixtureRunResults
+        : FixtureRunResults Task
         =
-        progress.OnTestFixtureStart name tests.Tests.Length
+        task {
+            let! running = par.StartTestFixture tests
+            progress.OnTestFixtureStart name tests.Tests.Length
 
-        let oldWorkDir = Environment.CurrentDirectory
-        Environment.CurrentDirectory <- FileInfo(tests.ContainingAssembly.Location).Directory.FullName
+            let oldWorkDir = Environment.CurrentDirectory
+            Environment.CurrentDirectory <- FileInfo(tests.ContainingAssembly.Location).Directory.FullName
 
-        let sw = Stopwatch.StartNew ()
-        let startTime = DateTimeOffset.UtcNow
+            let sw = Stopwatch.StartNew ()
+            let startTime = DateTimeOffset.UtcNow
 
-        use stdOutStream = new MemoryStream ()
-        use stdOut = new StreamWriter (stdOutStream)
-        use stdErrStream = new MemoryStream ()
-        use stdErr = new StreamWriter (stdErrStream)
-        use _ = new StdoutSetter (stdOut, stdErr)
+            let endMetadata (outputId : OutputStreamId) =
+                let stdOut = contexts.DumpStdout outputId
+                let stdErr = contexts.DumpStderr outputId
 
-        let endMetadata () =
-            let stdOut = stdOutStream.ToArray () |> Console.OutputEncoding.GetString
-            let stdErr = stdErrStream.ToArray () |> Console.OutputEncoding.GetString
+                {
+                    Total = sw.Elapsed
+                    Start = startTime
+                    End = DateTimeOffset.UtcNow
+                    ComputerName = Environment.MachineName
+                    ExecutionId = Guid.NewGuid ()
+                    TestId = Guid.NewGuid ()
+                    // This one is a bit dubious, because we don't actually have a test name at all
+                    TestName = name
+                    ClassName = tests.Name
+                    StdOut = if String.IsNullOrEmpty stdOut then None else Some stdOut
+                    StdErr = if String.IsNullOrEmpty stdErr then None else Some stdErr
+                }
 
-            {
-                Total = sw.Elapsed
-                Start = startTime
-                End = DateTimeOffset.UtcNow
-                ComputerName = Environment.MachineName
-                ExecutionId = Guid.NewGuid ()
-                TestId = Guid.NewGuid ()
-                // This one is a bit dubious, because we don't actually have a test name at all
-                TestName = name
-                ClassName = tests.Name
-                StdOut = if String.IsNullOrEmpty stdOut then None else Some stdOut
-                StdErr = if String.IsNullOrEmpty stdErr then None else Some stdErr
-            }
+            let! setupResult, running =
+                match tests.OneTimeSetUp with
+                | Some su ->
+                    par.RunTestSetup
+                        running
+                        (fun () ->
+                            let oldValue = contexts.AsyncLocal.Value
+                            let newOutputs = contexts.NewOutputs ()
+                            contexts.AsyncLocal.Value <- newOutputs
 
-        let setupResult =
-            match tests.OneTimeSetUp with
-            | Some su ->
-                try
-                    match su.Invoke (containingObject, [||]) with
-                    | :? unit -> None
-                    | ret -> Some (UserMethodFailure.ReturnedNonUnit (su.Name, ret), endMetadata ())
-                with :? TargetInvocationException as e ->
-                    Some (UserMethodFailure.Threw (su.Name, e.InnerException), endMetadata ())
-            | _ -> None
+                            let result =
+                                try
+                                    match su.Invoke (containingObject, [||]) with
+                                    | :? unit -> None
+                                    | ret ->
+                                        Some (UserMethodFailure.ReturnedNonUnit (su.Name, ret), endMetadata newOutputs)
+                                with :? TargetInvocationException as e ->
+                                    Some (UserMethodFailure.Threw (su.Name, e.InnerException), endMetadata newOutputs)
 
-        let testFailures = ResizeArray<TestMemberFailure * IndividualTestRunMetadata> ()
+                            contexts.AsyncLocal.Value <- oldValue
 
-        let successes =
-            ResizeArray<SingleTestMethod * TestMemberSuccess * IndividualTestRunMetadata> ()
+                            match result with
+                            | None -> Ok (Some newOutputs)
+                            | Some err -> Error (err, newOutputs)
+                        )
+                | _ -> Task.FromResult (Ok None, TestFixtureSetupToken.vouchNoSetupRequired running)
 
-        match setupResult with
-        | Some _ ->
-            // Don't run any tests if setup failed.
-            ()
-        | None ->
-            for test in tests.Tests do
-                if filter tests test then
-                    progress.OnTestMemberStart test.Name
-                    let testSuccess = ref 0
+            let testFailures = ResizeArray<TestMemberFailure * IndividualTestRunMetadata> ()
 
-                    let results = runTestsFromMember tests.SetUp tests.TearDown containingObject test
+            let successes =
+                ResizeArray<SingleTestMethod * TestMemberSuccess * IndividualTestRunMetadata> ()
 
-                    for result, report in results do
-                        match result with
-                        | Error failure ->
-                            testFailures.Add (failure, report)
-                            progress.OnTestFailed test.Name failure
-                        | Ok result ->
-                            Interlocked.Increment testSuccess |> ignore<int>
-                            lock successes (fun () -> successes.Add (test, result, report))
+            let testsRun =
+                match setupResult with
+                | Error _ ->
+                    // Don't run any tests if setup failed.
+                    Task.FromResult ()
+                | Ok _ ->
+                    tests.Tests
+                    |> Seq.filter (fun test ->
+                        if filter tests test then
+                            true
+                        else
+                            progress.OnTestMemberSkipped test.Name
+                            false
+                    )
+                    |> Seq.map (fun test ->
+                        task {
+                            let testSuccess = ref 0
 
-                    progress.OnTestMemberFinished test.Name
-                else
-                    progress.OnTestMemberSkipped test.Name
+                            let results =
+                                runTestsFromMember
+                                    contexts
+                                    par
+                                    running
+                                    progress
+                                    tests.SetUp
+                                    tests.TearDown
+                                    containingObject
+                                    test
 
-        // Unconditionally run OneTimeTearDown if it exists.
-        let tearDownError =
-            match tests.OneTimeTearDown with
-            | Some td ->
-                try
-                    match td.Invoke (containingObject, [||]) with
-                    | null -> None
-                    | ret -> Some (UserMethodFailure.ReturnedNonUnit (td.Name, ret), endMetadata ())
-                with :? TargetInvocationException as e ->
-                    Some (UserMethodFailure.Threw (td.Name, e), endMetadata ())
-            | _ -> None
+                            let! result =
+                                results
+                                |> List.map (fun t ->
+                                    task {
+                                        let! result, report = t
 
-        Environment.CurrentDirectory <- oldWorkDir
+                                        match result with
+                                        | Error failure ->
+                                            testFailures.Add (failure, report)
+                                            progress.OnTestFailed test.Name failure
+                                        | Ok result ->
+                                            Interlocked.Increment testSuccess |> ignore<int>
+                                            lock successes (fun () -> successes.Add (test, result, report))
+                                    }
+                                )
+                                |> Task.WhenAll
 
-        {
-            Failed = testFailures |> Seq.toList
-            Success = successes |> Seq.toList
-            OtherFailures = [ tearDownError ; setupResult ] |> List.choose id
+                            result |> Array.iter id
+                        }
+                    )
+                    |> Task.WhenAll
+                    |> fun t ->
+                        task {
+                            let! t = t
+                            return t |> Array.iter id
+                        }
+
+            do! testsRun
+
+            // Unconditionally run OneTimeTearDown if it exists.
+            let! tearDownError, tornDown =
+                match tests.OneTimeTearDown with
+                | Some td ->
+                    par.RunTestTearDown
+                        running
+                        (fun () ->
+                            let oldValue = contexts.AsyncLocal.Value
+                            let outputs = contexts.NewOutputs ()
+                            contexts.AsyncLocal.Value <- outputs
+
+                            let result =
+                                try
+                                    match td.Invoke (containingObject, [||]) with
+                                    | :? unit -> None
+                                    | ret ->
+                                        Some (UserMethodFailure.ReturnedNonUnit (td.Name, ret), endMetadata outputs)
+                                with :? TargetInvocationException as e ->
+                                    Some (UserMethodFailure.Threw (td.Name, e.InnerException), endMetadata outputs)
+
+                            contexts.AsyncLocal.Value <- oldValue
+
+                            match result with
+                            | None -> Ok (Some outputs)
+                            | Some err -> Error (err, outputs)
+                        )
+                | _ -> Task.FromResult (Ok None, TestFixtureTearDownToken.vouchNoTearDownRequired running)
+
+            Environment.CurrentDirectory <- oldWorkDir
+
+            do! par.EndTestFixture tornDown
+
+            // TODO: we have access to stdout/err of OneTimeSetUp and OneTimeTearDown here, but we throw them away.
+            return
+                {
+                    Failed = testFailures |> Seq.toList
+                    Success = successes |> Seq.toList
+                    OtherFailures =
+                        [ tearDownError ; setupResult ]
+                        |> List.choose (
+                            function
+                            | Error (e, _) -> Some e
+                            | Ok _ -> None
+                        )
+                }
         }
 
     /// Interpret this type as a [<TestFixture>], extracting the test members from it and annotating them with all
     /// relevant information about how we should run them.
     let parse (parentType : Type) : TestFixture =
-        let categories, args =
-            (([], []), parentType.CustomAttributes)
-            ||> Seq.fold (fun (categories, args) attr ->
+        let categories, args, par =
+            (([], [], None), parentType.CustomAttributes)
+            ||> Seq.fold (fun (categories, args, par) attr ->
                 match attr.AttributeType.FullName with
                 | "NUnit.Framework.SetUpFixtureAttribute" ->
                     failwith "This test runner does not support SetUpFixture. Please shout if you want this."
                 | "NUnit.Framework.CategoryAttribute" ->
                     let cat = attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox<string>
-                    cat :: categories, args
+                    cat :: categories, args, par
                 | "NUnit.Framework.TestFixtureAttribute" ->
                     let newArgs =
                         match attr.ConstructorArguments |> Seq.map _.Value |> Seq.toList with
@@ -536,11 +606,36 @@ module TestFixture =
                             x |> Seq.cast<CustomAttributeTypedArgument> |> Seq.map _.Value |> Seq.toList
                         | xs -> xs
 
-                    categories, newArgs :: args
-                | _ -> categories, args
+                    categories, newArgs :: args, par
+                | "NUnit.Framework.NonParallelizableAttribute" ->
+                    match par with
+                    | Some _ -> failwith $"Got multiple parallelism attributes on %s{parentType.FullName}"
+                    | None -> categories, args, Some Parallelizable.No
+                | "NUnit.Framework.ParallelizableAttribute" ->
+                    match par with
+                    | Some _ -> failwith $"Got multiple parallelism attributes on %s{parentType.FullName}"
+                    | None ->
+                        match attr.ConstructorArguments |> Seq.toList with
+                        | [] -> categories, args, Some (Parallelizable.Yes ClassParallelScope.Self)
+                        | [ v ] ->
+                            match v.Value with
+                            | :? int as v ->
+                                match v with
+                                | 512 -> categories, args, Some (Parallelizable.Yes ClassParallelScope.Fixtures)
+                                | 256 -> categories, args, Some (Parallelizable.Yes ClassParallelScope.Children)
+                                | 257 -> categories, args, Some (Parallelizable.Yes ClassParallelScope.All)
+                                | 1 -> categories, args, Some (Parallelizable.Yes ClassParallelScope.Self)
+                                | v ->
+                                    failwith
+                                        $"Could not recognise value %i{v} of parallel scope in %s{parentType.FullName}"
+                            | v ->
+                                failwith
+                                    $"Unexpectedly non-int value %O{v} of parallel scope in %s{parentType.FullName}"
+                        | _ -> failwith $"unexpectedly got multiple args to Parallelizable on %s{parentType.FullName}"
+                | _ -> categories, args, par
             )
 
-        (TestFixture.Empty parentType args, parentType.GetRuntimeMethods ())
+        (TestFixture.Empty parentType par args, parentType.GetRuntimeMethods ())
         ||> Seq.fold (fun state mi ->
             ((state, []), mi.CustomAttributes)
             ||> Seq.fold (fun (state, unrecognisedAttrs) attr ->
@@ -614,10 +709,12 @@ module TestFixture =
     /// Run every test (except those which fail the `filter`) in this test fixture, as well as the
     /// appropriate setup and tear-down logic.
     let run
+        (contexts : TestContexts)
+        (par : ParallelQueue)
         (progress : ITestProgress)
         (filter : TestFixture -> SingleTestMethod -> bool)
         (tests : TestFixture)
-        : FixtureRunResults list
+        : FixtureRunResults list Task
         =
         match tests.Parameters with
         | [] -> [ null ]
@@ -653,5 +750,11 @@ module TestFixture =
                     let args = args |> Seq.map (fun o -> o.ToString ()) |> String.concat ","
                     $"%s{tests.Name}(%s{args})"
 
-            runOneFixture progress filter name containingObject tests
+            runOneFixture contexts par progress filter name containingObject tests
         )
+        |> Task.WhenAll
+        |> fun t ->
+            task {
+                let! t = t
+                return Array.toList t
+            }

WoofWare.NUnitTestRunner.Lib/WoofWare.NUnitTestRunner.Lib.fsproj

@@ -29,8 +29,10 @@
       <Compile Include="Result.fs" />
       <Compile Include="Domain.fs" />
       <Compile Include="Filter.fs" />
+      <Compile Include="ParallelQueue.fs" />
       <Compile Include="SingleTestMethod.fs" />
       <Compile Include="TestProgress.fs" />
+      <Compile Include="Context.fs" />
       <Compile Include="TestFixture.fs" />
       <Compile Include="Xml.fs" />
       <Compile Include="TrxReport.fs" />

WoofWare.NUnitTestRunner.Lib/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "0.11",
+  "version": "0.13",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],

WoofWare.NUnitTestRunner/Program.fs

@@ -2,8 +2,8 @@
 
 open System
 open System.IO
-open System.Reflection
-open System.Runtime.Loader
+open System.Threading.Tasks
+open Spectre.Console
 
 // Fix for https://github.com/Smaug123/unofficial-nunit-runner/issues/8
 // Set AppContext.BaseDirectory to where the test DLL is.
@@ -16,62 +16,195 @@ type SetBaseDir (testDll : FileInfo) =
         member _.Dispose () =
             AppContext.SetData ("APP_CONTEXT_BASE_DIRECTORY", oldBaseDir)
 
+[<RequireQualifiedAccess>]
+type LogLevel =
+    | Nothing
+    | Verbose
 
-type Ctx (dll : FileInfo, runtimes : DirectoryInfo list) =
-    inherit AssemblyLoadContext ()
-
-    override this.Load (target : AssemblyName) : Assembly =
-        let path = Path.Combine (dll.Directory.FullName, $"%s{target.Name}.dll")
-
-        if File.Exists path then
-            this.LoadFromAssemblyPath path
+[<AutoOpen>]
+module Patterns =
+    let (|Key|_|) (start : string) (s : string) : string option =
+        if s.StartsWith (start + "=", StringComparison.Ordinal) then
+            s.Substring (start.Length + 1) |> Some
         else
+            None
 
-        runtimes
-        |> List.tryPick (fun di ->
-            let path = Path.Combine (di.FullName, $"%s{target.Name}.dll")
+type Args =
+    {
+        Dll : FileInfo
+        Trx : FileInfo option
+        Filter : Filter option
+        Logging : LogLevel
+        LevelOfParallelism : int option
+        Timeout : TimeSpan option
+    }
 
-            if File.Exists path then
-                this.LoadFromAssemblyPath path |> Some
-            else
-                None
-        )
-        |> Option.defaultValue null
+    static member Parse (args : string list) : Args =
+        match args with
+        | [] -> failwith "The first arg must be a positional arg, the DLL to test."
+        | dll :: args ->
 
+        let rec go
+            (trx : FileInfo option)
+            (filter : Filter option)
+            (logging : LogLevel option)
+            (par : int option)
+            (timeout : TimeSpan option)
+            (args : string list)
+            =
+            match args with
+            | [] ->
+                {
+                    Dll = FileInfo dll
+                    Trx = trx
+                    Filter = filter
+                    Logging = logging |> Option.defaultValue LogLevel.Nothing
+                    LevelOfParallelism = par
+                    Timeout = timeout
+                }
+            | Key "--filter" filterStr :: rest
+            | "--filter" :: filterStr :: rest ->
+                match filter with
+                | Some _ -> failwith "Two conflicting filters; you can only specify --filter once"
+                | None -> go trx (Some (Filter.parse filterStr)) logging par timeout rest
+            | Key "--trx" trxStr :: rest
+            | "--trx" :: trxStr :: rest ->
+                match trx with
+                | Some _ -> failwith "Two conflicting TRX outputs; you can only specify --trx once"
+                | None -> go (Some (FileInfo trxStr)) filter logging par timeout rest
+            | Key "--verbose" verboseStr :: rest
+            | "--verbose" :: verboseStr :: rest ->
+                match logging with
+                | Some _ -> failwith "Two conflicting --verbose outputs; you can only specify --verbose once"
+                | None ->
+                    let verbose =
+                        if Boolean.Parse verboseStr then
+                            LogLevel.Verbose
+                        else
+                            LogLevel.Nothing
+
+                    go trx filter (Some verbose) par timeout rest
+            | Key "--parallelism" parStr :: rest
+            | "--parallelism" :: parStr :: rest ->
+                match par with
+                | Some _ -> failwith "Two conflicting --parallelism outputs; you can only specify --parallelism once"
+                | None -> go trx filter logging (Some (Int32.Parse parStr)) timeout rest
+            | Key "--timeout-seconds" timeoutStr :: rest
+            | "--timeout-seconds" :: timeoutStr :: rest ->
+                match timeout with
+                | Some _ ->
+                    failwith "Two conflicting --timeout-seconds outputs; you can only specify --timeout-seconds once"
+                | None -> go trx filter logging par (Some (TimeSpan.FromSeconds (Int32.Parse timeoutStr |> float))) rest
+            | k :: _rest -> failwith $"Unrecognised arg %s{k}"
+
+        go None None None None None args
 
 module Program =
     let main argv =
         let startTime = DateTimeOffset.Now
 
-        let testDll, filter, trxPath =
-            match argv |> List.ofSeq with
-            | [ dll ] -> FileInfo dll, None, None
-            | [ dll ; "--trx" ; trxPath ] -> FileInfo dll, None, Some (FileInfo trxPath)
-            | [ dll ; "--filter" ; filter ] -> FileInfo dll, Some (Filter.parse filter), None
-            | [ dll ; "--trx" ; trxPath ; "--filter" ; filter ] ->
-                FileInfo dll, Some (Filter.parse filter), Some (FileInfo trxPath)
-            | [ dll ; "--filter" ; filter ; "--trx" ; trxPath ] ->
-                FileInfo dll, Some (Filter.parse filter), Some (FileInfo trxPath)
-            | _ ->
-                failwith
-                    "provide exactly one arg, a test DLL; then optionally `--filter <filter>` and/or `--trx <output-filename>`."
+        let args = argv |> List.ofArray |> Args.Parse
 
         let filter =
-            match filter with
+            match args.Filter with
             | Some filter -> Filter.shouldRun filter
             | None -> fun _ _ -> true
 
-        let progress = Progress.spectre ()
+        let stderr =
+            let consoleSettings = AnsiConsoleSettings ()
+            consoleSettings.Out <- AnsiConsoleOutput Console.Error
+            AnsiConsole.Create consoleSettings
 
-        use _ = new SetBaseDir (testDll)
+        let progress = Progress.spectre stderr
 
-        let ctx = Ctx (testDll, DotnetRuntime.locate testDll)
-        let assy = ctx.LoadFromAssemblyPath testDll.FullName
+        let runtime = DotnetRuntime.locate args.Dll
+
+        match args.Logging with
+        | LogLevel.Nothing -> ()
+        | LogLevel.Verbose ->
+            for d in runtime do
+                stderr.WriteLine $".NET runtime directory: %s{d.FullName}"
+
+        use _ = new SetBaseDir (args.Dll)
+
+        use contexts = TestContexts.Empty ()
+
+        let ctx = LoadContext (args.Dll, runtime, contexts)
+        let assy = ctx.LoadFromAssemblyPath args.Dll.FullName
+
+        let levelOfParallelism, par =
+            ((None, None), assy.CustomAttributes)
+            ||> Seq.fold (fun (levelPar, par) attr ->
+                match attr.AttributeType.FullName with
+                | "NUnit.Framework.LevelOfParallelismAttribute" ->
+                    let arg = attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox<int>
+
+                    match levelPar with
+                    | None -> (Some arg, par)
+                    | Some existing ->
+                        failwith $"Assembly %s{assy.Location} declares parallelism %i{arg} and also %i{existing}"
+                | "NUnit.Framework.NonParallelizableAttribute" ->
+                    match levelPar with
+                    | None -> (Some 1, par)
+                    | Some existing ->
+                        failwith
+                            $"Assembly %s{assy.Location} declares non-parallelizable and also parallelism %i{existing}"
+                | "NUnit.Framework.ParallelizableAttribute" ->
+                    match par with
+                    | Some _ -> failwith "Got multiple Parallelize attributes in assembly"
+                    | None ->
+                        match attr.ConstructorArguments |> Seq.toList with
+                        | [] -> levelPar, Some (Parallelizable.Yes AssemblyParallelScope.Fixtures)
+                        | [ v ] ->
+                            match v.Value with
+                            | :? int as v ->
+                                match v with
+                                | 512 -> levelPar, Some (Parallelizable.Yes AssemblyParallelScope.Fixtures)
+                                | 256 -> levelPar, Some (Parallelizable.Yes AssemblyParallelScope.Children)
+                                | 257 ->
+                                    failwith "ParallelScope.All is invalid on assemblies; only Fixtures or Children"
+                                | 1 ->
+                                    failwith "ParallelScope.Self is invalid on assemblies; only Fixtures or Children"
+                                | v -> failwith $"Could not recognise value %i{v} of parallel scope on assembly"
+                            | v -> failwith $"Unexpectedly non-int value %O{v} of parallel scope on assembly"
+                        | _ -> failwith "unexpectedly got multiple args to Parallelizable on assembly"
+                | _ -> levelPar, par
+            )
+
+        let levelOfParallelism =
+            match args.LevelOfParallelism, levelOfParallelism with
+            | None, None -> None
+            | Some taken, Some ignored ->
+                match args.Logging with
+                | LogLevel.Nothing -> ()
+                | LogLevel.Verbose ->
+                    stderr.WriteLine
+                        $"Taking parallelism %i{taken} from command line, ignoring value %i{ignored} from assembly"
+
+                Some taken
+            | Some x, None
+            | None, Some x -> Some x
 
         let testFixtures = assy.ExportedTypes |> Seq.map TestFixture.parse |> Seq.toList
 
+        use par = new ParallelQueue (levelOfParallelism, par)
+
         let creationTime = DateTimeOffset.Now
-        let results = testFixtures |> List.collect (TestFixture.run progress filter)
+
+        let results =
+            testFixtures
+            |> List.map (TestFixture.run contexts par progress filter)
+            |> Task.WhenAll
+
+        let timeout =
+            match args.Timeout with
+            | None -> TimeSpan.FromHours 2.0
+            | Some t -> t
+
+        if not (results.Wait timeout) then
+            failwith "Tests failed to terminate within two hours"
+
+        let results = results.Result |> Seq.concat |> List.ofSeq
 
         let finishTime = DateTimeOffset.Now
         let finishTimeHumanReadable = finishTime.ToString @"yyyy-MM-dd HH:mm:ss"
@@ -301,7 +434,7 @@ module Program =
                 ResultsSummary = resultSummary
             }
 
-        match trxPath with
+        match args.Trx with
         | Some trxPath ->
             let contents = TrxReport.toXml report |> fun d -> d.OuterXml
             trxPath.Directory.Create ()

WoofWare.NUnitTestRunner/Progress.fs

@@ -4,21 +4,21 @@ open Spectre.Console
 
 [<RequireQualifiedAccess>]
 module Progress =
-    let spectre () : ITestProgress =
+    let spectre (console : IAnsiConsole) : ITestProgress =
         { new ITestProgress with
             member _.OnTestFailed name failure =
-                AnsiConsole.Console.MarkupLine
+                console.MarkupLine
                     $"[red]Test '%s{Markup.Escape name}' failed: %s{Markup.Escape (failure.ToString ())}[/]"
 
             member _.OnTestFixtureStart name testCount =
-                AnsiConsole.Console.MarkupLine $"[white]Running tests: %s{Markup.Escape name}[/]"
+                console.MarkupLine $"[white]Running tests: %s{Markup.Escape name}[/]"
 
             member _.OnTestMemberFinished name =
-                AnsiConsole.Console.MarkupLine $"[gray]Finished test: %s{Markup.Escape name}[/]"
+                console.MarkupLine $"[gray]Finished test: %s{Markup.Escape name}[/]"
 
             member _.OnTestMemberSkipped name =
-                AnsiConsole.Console.MarkupLine $"[yellow]Skipping test due to filter: %s{Markup.Escape name}[/]"
+                console.MarkupLine $"[yellow]Skipping test due to filter: %s{Markup.Escape name}[/]"
 
             member _.OnTestMemberStart name =
-                AnsiConsole.Console.MarkupLine $"[white]Running test: %s{Markup.Escape name}[/]"
+                console.MarkupLine $"[white]Running test: %s{Markup.Escape name}[/]"
         }