Abstract out a Progress indicator (#28)

TestRunner.Lib/Domain.fs

@@ -131,3 +131,22 @@ type TestFailure =
         | TestFailure.TestFailed f
         | TestFailure.SetUpFailed f
         | TestFailure.TearDownFailed f -> f.Name
+
+/// Represents the result of a test that didn't fail.
+[<RequireQualifiedAccess>]
+type TestMemberSuccess =
+    /// The test passed.
+    | Ok
+    /// We didn't run the test, because it's [<Ignore>].
+    | Ignored of reason : string option
+    /// We didn't run the test, because it's [<Explicit>].
+    | Explicit of reason : string option
+
+/// Represents the failure of a test.
+[<RequireQualifiedAccess>]
+type TestMemberFailure =
+    /// We couldn't run this test because it was somehow malformed in a way we detected up front.
+    | Malformed of reasons : string list
+    /// We tried to run the test, but it failed. (A single test can fail many times, e.g. if it failed and also
+    /// the tear-down logic failed afterwards.)
+    | Failed of TestFailure list

TestRunner.Lib/SurfaceBaseline.txt

@@ -73,6 +73,12 @@ TestRunner.FixtureRunResults.get_OtherFailures [method]: unit -> TestRunner.User
 TestRunner.FixtureRunResults.get_SuccessCount [method]: unit -> int
 TestRunner.FixtureRunResults.OtherFailures [property]: [read-only] TestRunner.UserMethodFailure list
 TestRunner.FixtureRunResults.SuccessCount [property]: [read-only] int
+TestRunner.ITestProgress - interface with 5 member(s)
+TestRunner.ITestProgress.OnTestFailed [method]: string -> TestRunner.TestMemberFailure -> unit
+TestRunner.ITestProgress.OnTestFixtureStart [method]: string -> int -> unit
+TestRunner.ITestProgress.OnTestMemberFinished [method]: string -> unit
+TestRunner.ITestProgress.OnTestMemberSkipped [method]: string -> unit
+TestRunner.ITestProgress.OnTestMemberStart [method]: string -> unit
 TestRunner.Match inherit obj, implements TestRunner.Match System.IEquatable, System.Collections.IStructuralEquatable, TestRunner.Match System.IComparable, System.IComparable, System.Collections.IStructuralComparable - union type with 2 cases
 TestRunner.Match+Contains inherit TestRunner.Match
 TestRunner.Match+Contains.get_Item [method]: unit -> string
@@ -171,7 +177,7 @@ TestRunner.TestFixture.TearDown [property]: [read-only] System.Reflection.Method
 TestRunner.TestFixture.Tests [property]: [read-only] TestRunner.SingleTestMethod list
 TestRunner.TestFixtureModule inherit obj
 TestRunner.TestFixtureModule.parse [static method]: System.Type -> TestRunner.TestFixture
-TestRunner.TestFixtureModule.run [static method]: (TestRunner.TestFixture -> TestRunner.SingleTestMethod -> bool) -> TestRunner.TestFixture -> TestRunner.FixtureRunResults
+TestRunner.TestFixtureModule.run [static method]: TestRunner.ITestProgress -> (TestRunner.TestFixture -> TestRunner.SingleTestMethod -> bool) -> TestRunner.TestFixture -> TestRunner.FixtureRunResults
 TestRunner.TestKind inherit obj, implements TestRunner.TestKind System.IEquatable, System.Collections.IStructuralEquatable - union type with 3 cases
 TestRunner.TestKind+Data inherit TestRunner.TestKind
 TestRunner.TestKind+Data.get_Item [method]: unit -> obj list list
@@ -236,6 +242,8 @@ TestRunner.TestMemberSuccess.NewExplicit [static method]: string option -> TestR
 TestRunner.TestMemberSuccess.NewIgnored [static method]: string option -> TestRunner.TestMemberSuccess
 TestRunner.TestMemberSuccess.Ok [static property]: [read-only] TestRunner.TestMemberSuccess
 TestRunner.TestMemberSuccess.Tag [property]: [read-only] int
+TestRunner.TestProgress inherit obj
+TestRunner.TestProgress.toStderr [static method]: unit -> TestRunner.ITestProgress
 TestRunner.UserMethodFailure inherit obj, implements TestRunner.UserMethodFailure System.IEquatable, System.Collections.IStructuralEquatable - union type with 2 cases
 TestRunner.UserMethodFailure+ReturnedNonUnit inherit TestRunner.UserMethodFailure
 TestRunner.UserMethodFailure+ReturnedNonUnit.get_name [method]: unit -> string

TestRunner.Lib/TestFixture.fs

@@ -5,25 +5,6 @@ open System.Reflection
 open System.Threading
 open Microsoft.FSharp.Core
 
-/// Represents the result of a test that didn't fail.
-[<RequireQualifiedAccess>]
-type TestMemberSuccess =
-    /// The test passed.
-    | Ok
-    /// We didn't run the test, because it's [<Ignore>].
-    | Ignored of reason : string option
-    /// We didn't run the test, because it's [<Explicit>].
-    | Explicit of reason : string option
-
-/// Represents the failure of a test.
-[<RequireQualifiedAccess>]
-type TestMemberFailure =
-    /// We couldn't run this test because it was somehow malformed in a way we detected up front.
-    | Malformed of reasons : string list
-    /// We tried to run the test, but it failed. (A single test can fail many times, e.g. if it failed and also
-    /// the tear-down logic failed afterwards.)
-    | Failed of TestFailure list
-
 /// The results of running a single TestFixture.
 type FixtureRunResults =
     {
@@ -269,8 +250,13 @@ 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 (filter : TestFixture -> SingleTestMethod -> bool) (tests : TestFixture) : FixtureRunResults =
-        eprintfn $"Running test fixture: %s{tests.Name} (%i{tests.Tests.Length} tests to run)"
+    let run
+        (progress : ITestProgress)
+        (filter : TestFixture -> SingleTestMethod -> bool)
+        (tests : TestFixture)
+        : FixtureRunResults
+        =
+        progress.OnTestFixtureStart tests.Name tests.Tests.Length
 
         let containingObject =
             let methods =
@@ -316,7 +302,7 @@ module TestFixture =
         | None ->
             for test in tests.Tests do
                 if filter tests test then
-                    eprintfn $"Running test: %s{test.Name}"
+                    progress.OnTestMemberStart test.Name
                     let testSuccess = ref 0
 
                     let results = runTestsFromMember tests.SetUp tests.TearDown containingObject test
@@ -325,13 +311,13 @@ module TestFixture =
                         match result with
                         | Error failure ->
                             testFailures.Add failure
-                            eprintfn $"Test failed: %O{failure}"
+                            progress.OnTestFailed test.Name failure
                         | Ok _ -> Interlocked.Increment testSuccess |> ignore<int>
 
                     Interlocked.Add (totalTestSuccess, testSuccess.Value) |> ignore<int>
-                    eprintfn $"Finished test %s{test.Name} (%i{testSuccess.Value} success)"
+                    progress.OnTestMemberFinished test.Name
                 else
-                    eprintfn $"Skipping test due to filter: %s{test.Name}"
+                    progress.OnTestMemberSkipped test.Name
 
         // Unconditionally run OneTimeTearDown if it exists.
         let tearDownError =

TestRunner.Lib/TestProgress.fs

@@ -0,0 +1,45 @@
+namespace TestRunner
+
+open System
+
+/// Represents something which knows how to report progress through a test suite.
+/// Note that we don't guarantee anything about parallelism; you must make sure
+/// all implementations are safe to run concurrently.
+type ITestProgress =
+    /// Called just before we start executing the setup logic for the given test fixture.
+    /// We tell you how many test methods there are in the fixture.
+    abstract OnTestFixtureStart : name : string -> testCount : int -> unit
+    /// Called just before we start executing the test(s) indicated by a particular method.
+    abstract OnTestMemberStart : name : string -> unit
+    /// Called when a test fails. (This may be called repeatedly with the same `name`, e.g. if the test
+    /// is run multiple times with different combinations of test data.)
+    abstract OnTestFailed : name : string -> failure : TestMemberFailure -> unit
+    /// Called when we've finished every test indicated by a particular method. (The test may have been run
+    /// multiple times, e.g. with different combinations of test data.)
+    abstract OnTestMemberFinished : name : string -> unit
+    /// Called when we decide not to run the test(s) indicated by a particular method (e.g. because it's
+    /// marked [<Explicit>]).
+    abstract OnTestMemberSkipped : name : string -> unit
+
+/// Methods for constructing specific ITestProgress objects.
+[<RequireQualifiedAccess>]
+module TestProgress =
+    /// An ITestProgress which logs to stderr.
+    let toStderr () : ITestProgress =
+        { new ITestProgress with
+            member _.OnTestFixtureStart name testCount =
+                let plural = if testCount = 1 then "" else "s"
+                Console.Error.WriteLine $"Running test fixture: %s{name} (%i{testCount} test%s{plural} to run)"
+
+            member _.OnTestMemberStart name =
+                Console.Error.WriteLine $"Running test: %s{name}"
+
+            member _.OnTestFailed name failure =
+                Console.Error.WriteLine $"Test failed: %O{failure}"
+
+            member _.OnTestMemberFinished name =
+                Console.Error.WriteLine $"Finished test %s{name}"
+
+            member _.OnTestMemberSkipped name =
+                Console.Error.WriteLine $"Skipping test due to filter: %s{name}"
+        }

TestRunner.Lib/TestRunner.Lib.fsproj

@@ -23,6 +23,7 @@
       <Compile Include="Domain.fs" />
       <Compile Include="Filter.fs" />
       <Compile Include="SingleTestMethod.fs" />
+      <Compile Include="TestProgress.fs" />
       <Compile Include="TestFixture.fs" />
       <None Include="..\README.md">
         <Pack>True</Pack>
@@ -33,6 +34,7 @@
     </ItemGroup>
   <ItemGroup>
     <PackageReference Include="WoofWare.PrattParser" Version="0.1.2" />
+    <PackageReference Update="FSharp.Core" Version="6.0.0" />
   </ItemGroup>
 
 </Project>

TestRunner.Lib/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "0.1",
+  "version": "0.2",
   "publicReleaseRefSpec": null,
   "pathFilters": [
     "./",

TestRunner/Program.fs

@@ -4,6 +4,17 @@ open System
 open System.IO
 open System.Reflection
 
+// Fix for https://github.com/Smaug123/unofficial-nunit-runner/issues/8
+// Set AppContext.BaseDirectory to where the test DLL is.
+// (This tells the DLL loader to look next to the test DLL for dependencies.)
+type SetBaseDir (testDll : FileInfo) =
+    let oldBaseDir = AppContext.BaseDirectory
+    do AppContext.SetData ("APP_CONTEXT_BASE_DIRECTORY", testDll.Directory.FullName)
+
+    interface IDisposable with
+        member _.Dispose () =
+            AppContext.SetData ("APP_CONTEXT_BASE_DIRECTORY", oldBaseDir)
+
 module Program =
     let main argv =
         let testDll, filter =
@@ -17,15 +28,13 @@ module Program =
             | Some filter -> Filter.shouldRun filter
             | None -> fun _ _ -> true
 
-        // Fix for https://github.com/Smaug123/unofficial-nunit-runner/issues/8
-        // Set AppContext.BaseDirectory to where the test DLL is.
-        // (This tells the DLL loader to look next to the test DLL for dependencies.)
-        let oldBaseDir = AppContext.BaseDirectory
-        AppContext.SetData ("APP_CONTEXT_BASE_DIRECTORY", testDll.Directory.FullName)
+        let progress = TestProgress.toStderr ()
+
+        use _ = new SetBaseDir (testDll)
+
         let assy = Assembly.LoadFrom testDll.FullName
 
         let anyFailures =
-            try
             assy.ExportedTypes
             // TODO: NUnit nowadays doesn't care if you're a TestFixture or not
             |> Seq.filter (fun ty ->
@@ -36,7 +45,7 @@ module Program =
                 (fun anyFailures ty ->
                     let testFixture = TestFixture.parse ty
 
-                        let results = TestFixture.run filter testFixture
+                    let results = TestFixture.run progress filter testFixture
 
                     let anyFailures =
                         match results.Failed with
@@ -59,8 +68,6 @@ module Program =
                     anyFailures
                 )
                 false
-            finally
-                AppContext.SetData ("APP_CONTEXT_BASE_DIRECTORY", oldBaseDir)
 
         if anyFailures then 1 else 0
 

nix/deps.nix

@@ -21,6 +21,11 @@
     version = "0.26.0";
     sha256 = "0xgv5kvbwfdvcp6s8x7xagbbi4s3mqa4ixni6pazqvyflbgnah7b";
   })
+  (fetchNuGet {
+    pname = "FSharp.Core";
+    version = "6.0.0";
+    sha256 = "1hjhvr39c1vpgrdmf8xln5q86424fqkvy9nirkr29vl2461d2039";
+  })
   (fetchNuGet {
     pname = "FSharp.Core";
     version = "8.0.300";