diff --git a/Consumer/TestParallel.fs b/Consumer/TestParallel.fs index 48facdd..f9c9060 100644 --- a/Consumer/TestParallel.fs +++ b/Consumer/TestParallel.fs @@ -10,7 +10,9 @@ module TestParallelDefault = let defaults = List.init 100 id [] - let ``Default thing`` (i : int) = i |> shouldEqual i + let ``Default thing`` (i : int) = + System.Console.WriteLine i + i |> shouldEqual i [] [] @@ -19,7 +21,9 @@ module TestParallelAllScope = let defaults = List.init 100 id [] - let ``Default thing`` (i : int) = i |> shouldEqual i + let ``Default thing`` (i : int) = + System.Console.WriteLine i + i |> shouldEqual i [] [] @@ -28,7 +32,9 @@ module TestParallelSelfScope = let defaults = List.init 100 id [] - let ``Default thing`` (i : int) = i |> shouldEqual i + let ``Default thing`` (i : int) = + System.Console.WriteLine i + i |> shouldEqual i [] [] @@ -37,7 +43,9 @@ module TestParallelChildrenScope = let defaults = List.init 100 id [] - let ``Default thing`` (i : int) = i |> shouldEqual i + let ``Default thing`` (i : int) = + System.Console.WriteLine i + i |> shouldEqual i [] [] @@ -46,4 +54,6 @@ module TestParallelFixturesScope = let defaults = List.init 100 id [] - let ``Default thing`` (i : int) = i |> shouldEqual i + let ``Default thing`` (i : int) = + System.Console.WriteLine i + i |> shouldEqual i diff --git a/Consumer/TestSetUp.fs b/Consumer/TestSetUp.fs index 3318377..4f462c0 100644 --- a/Consumer/TestSetUp.fs +++ b/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 = [] 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 = [] let setUp () = + Console.WriteLine "It's a set-up!" haveOneTimeSetUp.Value |> shouldEqual 1 let newId = Interlocked.Increment setUpTimes lock setUpTimesSeen (fun () -> setUpTimesSeen.Add newId) [] let tearDown () = + Console.WriteLine "I'm a tear-down!" let newId = Interlocked.Increment tearDownTimes lock tearDownTimesSeen (fun () -> tearDownTimesSeen.Add newId) @@ -35,6 +40,8 @@ module TestSetUp = [] 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" @@ -48,6 +55,7 @@ module TestSetUp = [] let ``Test 1`` () = haveOneTimeTearDown.Value |> shouldEqual 0 + Console.WriteLine "By the way, I'm test 1" 1 |> shouldEqual 1 [] diff --git a/WoofWare.NUnitTestRunner.Lib/Context.fs b/WoofWare.NUnitTestRunner.Lib/Context.fs new file mode 100644 index 0000000..f16a0a8 --- /dev/null +++ b/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, + underlying : Dictionary, + mem : Dictionary + ) + = + 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 + /// Accesses to this must be locked on StdErrWriters. + StdErrs : Dictionary + StdOutWriters : Dictionary + StdErrWriters : Dictionary + StdOutWriter : TextWriter + StdErrWriter : TextWriter + AsyncLocal : AsyncLocal + } + + /// 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 + let setErr = consoleType.GetMethod "SetError" + setErr.Invoke ((null : obj), [| contexts.Stderr |]) |> unbox + + assy + else + assy diff --git a/WoofWare.NUnitTestRunner.Lib/ParallelQueue.fs b/WoofWare.NUnitTestRunner.Lib/ParallelQueue.fs new file mode 100644 index 0000000..897e671 --- /dev/null +++ b/WoofWare.NUnitTestRunner.Lib/ParallelQueue.fs @@ -0,0 +1,152 @@ +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 + +[] +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 + +[] +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 + +[] +module private TestFixtureTearDownToken = + let vouchNoTearDownRequired (TestFixtureSetupToken tf) = TestFixtureTearDownToken tf + +type private MailboxMessage = + | Quit of AsyncReplyChannel + | RunTest of ThunkCrate + | BeginTestFixture of TestFixture * AsyncReplyChannel + | EndTestFixture of TestFixtureTearDownToken * AsyncReplyChannel + +type private MailboxState = + | Idle + | Running of TestFixture * (TestFixture * AsyncReplyChannel) list + +/// 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 option, ?ct : CancellationToken) + = + let rec processTask (state : MailboxState) (m : MailboxProcessor) = + async { + let! message = m.Receive () + + match message with + | Quit rc -> rc.Reply () + | BeginTestFixture (tf, rc) -> + match state with + | Running (current, rest) -> + let state = Running (current, (tf, rc) :: rest) + 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 rest with + | [] -> return! processTask Idle m + | (head, rc) :: tail -> + rc.Reply (TestFixtureRunningToken head) + return! processTask (Running (head, tail)) m + | RunTest message -> + // Currently we rely on the caller to only send this message when we've given them permission through + // the StartTestFixture method returning. + { new ThunkEvaluator<_> with + member _.Eval t rc = + use ec = ExecutionContext.Capture () + ExecutionContext.Run (ec, (fun _ -> rc.Reply (t ())), ()) + FakeUnit + } + |> message.Apply + |> function + | FakeUnit -> () + + return! processTask state m + } + + 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 = + ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply |> Async.StartAsTask + + /// Request to run the given action, obeying the parallelism constraints of the parent test fixture. + /// The resulting Task will return when the action has completed. + member _.ObeyParent<'a> (tf : TestFixtureSetupToken) (action : unit -> 'a) : 'a Task = + ThunkCrate.make action >> RunTest |> 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 = + fun rc -> 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 = + task { + let! response = ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply + return response, TestFixtureSetupToken tf + } + + /// Run the given one-time tear-down for the test fixture. + member _.RunTestTearDown (TestFixtureSetupToken tf) (action : unit -> 'a) : ('a * TestFixtureTearDownToken) Task = + task { + let! response = ThunkCrate.make action >> RunTest |> mb.PostAndAsyncReply + return response, TestFixtureTearDownToken tf + } + + /// 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 = + (fun rc -> 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 :> IDisposable).Dispose () diff --git a/WoofWare.NUnitTestRunner.Lib/SurfaceBaseline.txt b/WoofWare.NUnitTestRunner.Lib/SurfaceBaseline.txt index 7389790..7720360 100644 --- a/WoofWare.NUnitTestRunner.Lib/SurfaceBaseline.txt +++ b/WoofWare.NUnitTestRunner.Lib/SurfaceBaseline.txt @@ -143,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 @@ -195,6 +197,15 @@ 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.NonParallel [method]: WoofWare.NUnitTestRunner.TestFixtureSetupToken -> (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.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, unit WoofWare.NUnitTestRunner.Parallelizable option) WoofWare.NUnitTestRunner.SingleTestMethod.Categories [property]: [read-only] string list @@ -215,6 +226,8 @@ WoofWare.NUnitTestRunner.SingleTestMethod.Parallelize [property]: [read-only] un 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 @@ -267,7 +280,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 diff --git a/WoofWare.NUnitTestRunner.Lib/TestFixture.fs b/WoofWare.NUnitTestRunner.Lib/TestFixture.fs index e508bd5..cbca890 100644 --- a/WoofWare.NUnitTestRunner.Lib/TestFixture.fs +++ b/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 * IndividualTestRunMetadata) list + : (Result * 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 :> IEnumerable` 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) 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,116 +386,209 @@ 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 = + 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 + | 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 () + contexts.AsyncLocal.Value <- oldValue - let successes = - ResizeArray () + 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 () - let results = runTestsFromMember tests.SetUp tests.TearDown containingObject test + let successes = + ResizeArray () - 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 - 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 + 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 [], extracting the test members from it and annotating them with all @@ -639,10 +713,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 ] @@ -678,5 +754,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 + } diff --git a/WoofWare.NUnitTestRunner.Lib/WoofWare.NUnitTestRunner.Lib.fsproj b/WoofWare.NUnitTestRunner.Lib/WoofWare.NUnitTestRunner.Lib.fsproj index 8e4a2e3..ef8e202 100644 --- a/WoofWare.NUnitTestRunner.Lib/WoofWare.NUnitTestRunner.Lib.fsproj +++ b/WoofWare.NUnitTestRunner.Lib/WoofWare.NUnitTestRunner.Lib.fsproj @@ -29,8 +29,10 @@ + + diff --git a/WoofWare.NUnitTestRunner.Lib/version.json b/WoofWare.NUnitTestRunner.Lib/version.json index 6979dc4..56b562e 100644 --- a/WoofWare.NUnitTestRunner.Lib/version.json +++ b/WoofWare.NUnitTestRunner.Lib/version.json @@ -1,5 +1,5 @@ { - "version": "0.12", + "version": "0.13", "publicReleaseRefSpec": [ "^refs/heads/main$" ], diff --git a/WoofWare.NUnitTestRunner/Program.fs b/WoofWare.NUnitTestRunner/Program.fs index 8540298..c410c24 100644 --- a/WoofWare.NUnitTestRunner/Program.fs +++ b/WoofWare.NUnitTestRunner/Program.fs @@ -2,8 +2,7 @@ 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 @@ -18,28 +17,6 @@ type SetBaseDir (testDll : FileInfo) = AppContext.SetData ("APP_CONTEXT_BASE_DIRECTORY", oldBaseDir) -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 - 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 - - module Program = let main argv = let startTime = DateTimeOffset.Now @@ -71,7 +48,9 @@ module Program = use _ = new SetBaseDir (testDll) - let ctx = Ctx (testDll, DotnetRuntime.locate testDll) + use contexts = TestContexts.Empty () + + let ctx = LoadContext (testDll, DotnetRuntime.locate testDll, contexts) let assy = ctx.LoadFromAssemblyPath testDll.FullName let levelOfParallelism, par = @@ -115,8 +94,19 @@ module Program = 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 + + if not (results.Wait (TimeSpan.FromHours 2.0)) 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"