More runtimes (#81)

Consumer/Consumer.fsproj

@@ -10,6 +10,7 @@
     <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" />

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

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

Consumer/TestSetUp.fs

@@ -47,10 +47,11 @@ module TestSetUp =
 
         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`` () =

Consumer/TestValues.fs

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

WoofWare.NUnitTestRunner.Lib/Domain.fs

@@ -88,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.

WoofWare.NUnitTestRunner.Lib/DotnetRuntime.fs

@@ -7,11 +7,7 @@ open WoofWare.DotnetRuntimeLocator
 /// Functions for locating .NET runtimes.
 [<RequireQualifiedAccess>]
 module DotnetRuntime =
-    let private selectRuntime
+    let private selectRuntime (config : RuntimeOptions) (f : DotnetEnvironmentInfo) : DirectoryInfo list =
-        (config : RuntimeOptions)
-        (f : DotnetEnvironmentInfo)
-        : Choice<DotnetEnvironmentFrameworkInfo, DotnetEnvironmentSdkInfo> option
-        =
         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.toList
-                |> Seq.tryHead
 
-            match available with
+            // TODO: maybe we can ask the SDK if we don't have any runtimes.
-            | Some (_, f) -> Some (Choice1Of2 f)
+            // But we keep on trucking: maybe we're self-contained, and we'll actually find all the runtime next to the
-            | None ->
+            // DLL.
-                // TODO: maybe we can ask the SDK. But we keep on trucking: maybe we're self-contained,
+            available
-                // and we'll actually find all the runtime next to the DLL.
+            |> List.map (fun (_name, runtime) -> DirectoryInfo $"%s{runtime.Path}/%s{runtime.Version}")
-                None
         | _ -> 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
+        dll.Directory :: runtime
-        | 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 ]

WoofWare.NUnitTestRunner.Lib/ParallelQueue.fs

@@ -36,66 +36,311 @@ type TestFixtureTearDownToken = private | TestFixtureTearDownToken of TestFixtur
 module private TestFixtureTearDownToken =
     let vouchNoTearDownRequired (TestFixtureSetupToken tf) = TestFixtureTearDownToken tf
 
+[<RequireQualifiedAccess>]
 type private MailboxMessage =
     | Quit of AsyncReplyChannel<unit>
-    | RunTest of ThunkCrate
+    /// 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 TestFixture * (TestFixture * AsyncReplyChannel<TestFixtureRunningToken>) list
+    | 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)
+    (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
-            | Quit rc -> rc.Reply ()
+            | MailboxMessage.Quit rc -> rc.Reply ()
-            | BeginTestFixture (tf, rc) ->
+            | MailboxMessage.Reconcile ->
                 match state with
-                | Running (current, rest) ->
+                | Idle -> return! processTask state m
-                    let state = Running (current, (tf, rc) :: rest)
+                | Running r ->
-                    return! processTask state m
-                | Idle ->
-                    let state = Running (tf, [])
-                    rc.Reply (TestFixtureRunningToken tf)
-                    return! processTask state m
-            | EndTestFixture (TestFixtureTearDownToken tf, rc) ->
-                match state with
-                | Idle ->
-                    return failwith "Caller has somehow called EndTestFixture while we're not running a test fixture"
-                | Running (current, rest) ->
-                    if not (Object.ReferenceEquals (current, tf)) then
-                        return
-                            failwith
-                                "Caller has somehow called EndTestFixture while we're not running that test fixture"
 
-                    rc.Reply ()
+                match r.CurrentlyRunning with
-
+                | [] ->
-                    match rest with
+                    match r.Waiting with
                     | [] -> return! processTask Idle m
                     | (head, rc) :: tail ->
                         rc.Reply (TestFixtureRunningToken head)
-                        return! processTask (Running (head, tail)) m
+
-            | RunTest message ->
+                        let newRunning =
-                // Currently we rely on the caller to only send this message when we've given them permission through
+                            {
-                // the StartTestFixture method returning.
+                                Fixture = head
-                { new ThunkEvaluator<_> with
+                                Running = []
-                    member _.Eval t rc =
+                                RunningCanParallelize = true
-                        use ec = ExecutionContext.Capture ()
+                                Waiting = []
-                        ExecutionContext.Run (ec, (fun _ -> rc.Reply (t ())), ())
+                            }
-                        FakeUnit
+
-                }
+                        let state =
-                |> message.Apply
+                            {
-                |> function
+                                MaxParallelism = r.MaxParallelism
-                    | FakeUnit -> ()
+                                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
         }
@@ -103,50 +348,75 @@ type ParallelQueue
     let mb = new MailboxProcessor<_> (processTask MailboxState.Idle)
     do mb.Start ()
 
-    /// Request to run the given action on its own, not in parallel with anything else.
-    /// The resulting Task will return when the action has completed.
-    member _.NonParallel<'a> (parent : TestFixtureSetupToken) (action : unit -> 'a) : 'a Task =
-        ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply |> Async.StartAsTask
-
     /// Request to run the given action, freely in parallel with other running tests.
     /// The resulting Task will return when the action has completed.
-    member _.Parallel<'a> (parent : TestFixtureSetupToken) (action : unit -> 'a) : 'a Task =
+    member _.Run<'a>
-        ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply |> Async.StartAsTask
+        (TestFixtureSetupToken parent)
-
+        (scope : Parallelizable<unit> option)
-    /// Request to run the given action, obeying the parallelism constraints of the parent test fixture.
+        (action : unit -> 'a)
-    /// The resulting Task will return when the action has completed.
+        : 'a Task
-    member _.ObeyParent<'a> (tf : TestFixtureSetupToken) (action : unit -> 'a) : 'a Task =
+        =
-        ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply |> Async.StartAsTask
+        (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 -> BeginTestFixture (tf, rc)
+        fun rc -> MailboxMessage.BeginTestFixture (tf, rc)
         |> mb.PostAndAsyncReply
         |> Async.StartAsTask
 
     /// Run the given one-time setup for the test fixture.
-    member _.RunTestSetup (TestFixtureRunningToken tf) (action : unit -> 'a) : ('a * TestFixtureSetupToken) Task =
+    member _.RunTestSetup (TestFixtureRunningToken parent) (action : unit -> 'a) : ('a * TestFixtureSetupToken) Task =
         task {
-            let! response = ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply
+            let par =
-            return response, TestFixtureSetupToken tf
+                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 tf) (action : unit -> 'a) : ('a * TestFixtureTearDownToken) Task =
+    member _.RunTestTearDown
+        (TestFixtureSetupToken parent)
+        (action : unit -> 'a)
+        : ('a * TestFixtureTearDownToken) Task
+        =
         task {
-            let! response = ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply
+            let par =
-            return response, TestFixtureTearDownToken tf
+                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 -> EndTestFixture (tf, rc)) |> mb.PostAndAsyncReply |> Async.StartAsTask
+        (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 Quit
+            mb.PostAndReply MailboxMessage.Quit
             (mb :> IDisposable).Dispose ()

WoofWare.NUnitTestRunner.Lib/SurfaceBaseline.txt

@@ -200,9 +200,7 @@ 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.NonParallel [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> (unit -> 'a) -> 'a 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.ObeyParent [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> (unit -> 'a) -> 'a System.Threading.Tasks.Task
-WoofWare.NUnitTestRunner.ParallelQueue.Parallel [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> (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.Lib/TestFixture.fs

@@ -401,11 +401,7 @@ module TestFixture =
 
                     result, meta
 
-                let! results, summary =
+                let! results, summary = par.Run running test.Parallelize runMe
-                    match test.Parallelize with
-                    | Some Parallelizable.No -> par.NonParallel running runMe
-                    | Some (Parallelizable.Yes _) -> par.Parallel running runMe
-                    | None -> par.ObeyParent running runMe
 
                 match results with
                 | Ok results -> return Ok results, summary