diff --git a/src/Scriptorium.Quill/Prelude.fs b/src/Scriptorium.Quill/Prelude.fs
index b1a52a10..524fc4b2 100644
--- a/src/Scriptorium.Quill/Prelude.fs
+++ b/src/Scriptorium.Quill/Prelude.fs
@@ -132,3 +132,73 @@ module Prelude =
#if !FABLE_COMPILER_BEAM
()
#endif
+
+ /// The runtime type name of an exception, or None when the target cannot report one.
+ let exceptionTypeName (ex: exn) : string option =
+#if FABLE_COMPILER_JAVASCRIPT || FABLE_COMPILER_TYPESCRIPT
+ let name: string =
+ emitJsExpr ex "($0 && $0.constructor && $0.constructor.name) || ''"
+
+ match name with
+ | "" -> None
+ | name -> Some name
+#endif
+
+#if FABLE_COMPILER_PYTHON
+ let name: string = Fable.Core.PyInterop.emitPyExpr ex "type($0).__name__"
+
+ match name with
+ | "" -> None
+ | name -> Some name
+#endif
+
+#if FABLE_COMPILER_BEAM
+ // Fable lowers every F# exception to a bare `#{message => Binary}` map - no type tag - so
+ // there is nothing on the term to name.
+ ignore ex
+ None
+#endif
+
+#if !(FABLE_COMPILER_JAVASCRIPT || FABLE_COMPILER_TYPESCRIPT || FABLE_COMPILER_PYTHON || FABLE_COMPILER_BEAM)
+ match ex.GetType().FullName with
+ | null
+ | "" -> None
+ | name -> Some name
+#endif
+
+ /// The stack trace of an exception, or None when the target records none.
+ let exceptionStackTrace (ex: exn) : string option =
+#if FABLE_COMPILER_JAVASCRIPT || FABLE_COMPILER_TYPESCRIPT
+ // fable-library's `Exception` is deliberately not derived from `Error` (fable#2160), so
+ // only a natively thrown error carries a stack.
+ let trace: string = emitJsExpr ex "($0 && $0.stack) || ''"
+
+ match trace with
+ | "" -> None
+ | trace -> Some trace
+#endif
+
+#if FABLE_COMPILER_PYTHON
+ let trace: string =
+ Fable.Core.PyInterop.emitPyExpr
+ ex
+ "''.join(__import__('traceback').format_exception(type($0), $0, $0.__traceback__))"
+
+ match trace with
+ | "" -> None
+ | trace -> Some trace
+#endif
+
+#if FABLE_COMPILER_BEAM
+ // The BEAM keeps the stacktrace on the catch clause, not on the exception term, so by the
+ // time Fable hands the value to an F# `with` binding it is already gone.
+ ignore ex
+ None
+#endif
+
+#if !(FABLE_COMPILER_JAVASCRIPT || FABLE_COMPILER_TYPESCRIPT || FABLE_COMPILER_PYTHON || FABLE_COMPILER_BEAM)
+ match ex.StackTrace with
+ | null
+ | "" -> None
+ | trace -> Some trace
+#endif
diff --git a/src/Scriptorium.Quill/Quill.fs b/src/Scriptorium.Quill/Quill.fs
index eeabeb03..ee6d3b36 100644
--- a/src/Scriptorium.Quill/Quill.fs
+++ b/src/Scriptorium.Quill/Quill.fs
@@ -146,17 +146,48 @@ module internal Advanced =
}
)
)
- else
+ elif Compiler.isPython then
// Python drives its asyncs on one loop and BEAM on cheap processes, so neither starves
// the way the .NET thread pool does; both raise a message-less timeout, hence the
// relabelling. `Async.StartImmediate` is not an option on Python - it builds a detached
// trampoline whose continuations never reach the caller.
async {
+ let sw = UniversalStopwatch()
+
+ let timed =
+ async {
+ do! computation
+ return sw.ElapsedMs()
+ }
+
+ let! completedAt =
+ async {
+ try
+ let! timeoutable = Async.StartChild(timed, ms)
+ return! timeoutable
+ with :? System.TimeoutException ->
+ return raise (System.TimeoutException($"Test timed out after {ms}ms"))
+ }
+
+ // Async.StartChild can return normally even when the budget was blown.
+ if completedAt >= ms then
+ return raise (System.TimeoutException($"Test timed out after {ms}ms"))
+ }
+ else
+ async {
+ let sw = UniversalStopwatch()
+
try
let! timeoutable = Async.StartChild(computation, ms)
do! timeoutable
with :? System.TimeoutException ->
return raise (System.TimeoutException($"Test timed out after {ms}ms"))
+
+ // Async.StartChild can return normally even when the budget was blown.
+ // A mutable object cannot cross into a BEAM child process, so the body cannot
+ // time itself and the budget is measured from here instead.
+ if sw.ElapsedMs() >= ms then
+ return raise (System.TimeoutException($"Test timed out after {ms}ms"))
}
let runSequentially (asyncs: Async<'a list> list) : Async<'a list> =
@@ -261,18 +292,30 @@ module internal Advanced =
onResult r
async { return [ r ] }
+ let skipped reason =
+ TestResult.Skipped
+ {
+ Path = currentPath
+ FilePath = def.FilePath
+ LineNumber = def.LineNumber
+ Reason = reason
+ }
+
// Author explicitly marked this test as pending (xtest / todo).
// The body is never executed regardless of focus mode or config.
if def.Mark = TestMark.Pending then
- report (TestResult.Pending currentPath)
- // Runtime skip: either the configurer set Skip = true (e.g. skipIf),
- // or focus mode is active and this test is not focused nor under a
- // focused ancestor - so it is sidelined for this run.
- elif
- effectiveConfig.Skip
- || (anyFocused && not focusedAncestor && def.Mark = TestMark.Normal)
- then
- report (TestResult.Skipped currentPath)
+ report (
+ TestResult.Pending
+ {
+ Path = currentPath
+ FilePath = def.FilePath
+ LineNumber = def.LineNumber
+ }
+ )
+ elif effectiveConfig.Skip then
+ report (skipped SkipReason.Configured)
+ elif anyFocused && not focusedAncestor && def.Mark = TestMark.Normal then
+ report (skipped SkipReason.NotFocused)
else
let sw = UniversalStopwatch()
@@ -280,15 +323,19 @@ module internal Advanced =
TestResult.Passed
{
Path = currentPath
+ FilePath = def.FilePath
+ LineNumber = def.LineNumber
Duration = sw.ElapsedMs()
SlowThresholdMs = effectiveConfig.SlowThresholdMs
}
- let failed msg =
+ let failed (ex: exn) =
TestResult.Failed
{
Path = currentPath
- Message = msg
+ Message = ex.Message
+ ExceptionType = exceptionTypeName ex
+ StackTrace = exceptionStackTrace ex
FilePath = def.FilePath
LineNumber = def.LineNumber
Duration = sw.ElapsedMs()
@@ -300,7 +347,7 @@ module internal Advanced =
do! makeBody effectiveConfig sw
return! report (passed ())
with ex ->
- return! report (failed ex.Message)
+ return! report (failed ex)
}
match test with
@@ -371,8 +418,24 @@ module internal Advanced =
| TestMark.Pending ->
let rec collectPending p tc =
match tc with
- | TestCase.SyncTest def -> [ TestResult.Pending(def.Name :: p) ]
- | TestCase.AsyncTest def -> [ TestResult.Pending(def.Name :: p) ]
+ | TestCase.SyncTest def ->
+ [
+ TestResult.Pending
+ {
+ Path = def.Name :: p
+ FilePath = def.FilePath
+ LineNumber = def.LineNumber
+ }
+ ]
+ | TestCase.AsyncTest def ->
+ [
+ TestResult.Pending
+ {
+ Path = def.Name :: p
+ FilePath = def.FilePath
+ LineNumber = def.LineNumber
+ }
+ ]
| TestCase.TestList def ->
def.Tests |> List.collect (collectPending (def.Name :: p))
@@ -433,8 +496,8 @@ module internal Advanced =
match result with
| TestResult.Passed r -> r.Path
| TestResult.Failed r -> r.Path
- | TestResult.Skipped p -> p
- | TestResult.Pending p -> p
+ | TestResult.Skipped r -> r.Path
+ | TestResult.Pending r -> r.Path
results
|> List.fold
@@ -510,11 +573,144 @@ module internal Advanced =
let logger = Parchment.Create(Universal.console ())
+ let printDot (result: TestResult) : unit =
+ match result with
+ | TestResult.Passed r -> writeRaw (passedColor r "·")
+ | TestResult.Failed _ -> writeRaw (red "x")
+ | TestResult.Skipped _ -> writeRaw (dim "-")
+ | TestResult.Pending _ -> writeRaw (yellow "*")
+
+ let printRunReport (report: TestRunReport) : unit =
+ logger.info ""
+ logger.info ""
+ printResults logger report.Results
+ logger.info ""
+
+ let durationStr =
+ if report.Duration < 1000 then
+ $"{report.Duration}ms"
+ else
+ $"%.2f{(float report.Duration / 1000.0)}s".Replace(".00s", "s")
+
+ let startAt =
+ sprintf
+ "%02d:%02d:%02d"
+ report.StartTime.Hour
+ report.StartTime.Minute
+ report.StartTime.Second
+
+ let parts =
+ [
+ if report.FailedCount > 0 then
+ red $"{report.FailedCount} failed"
+ if isCI && report.AnyFocused then
+ red "focused (not allowed in CI)"
+ if report.PassedCount > 0 then
+ (green >> bold) $"{report.PassedCount} passed"
+ if report.SkippedCount > 0 then
+ dim $"{report.SkippedCount} skipped"
+ if report.PendingCount > 0 then
+ yellow $"{report.PendingCount} pending"
+ ]
+ |> String.concat " | "
+
+ let labelTests = dim ("Tests".PadLeft(9))
+ let labelStartAt = dim ("Start at".PadLeft(9))
+ let labelDuration = dim ("Duration".PadLeft(9))
+ let totalStr = dim $"({report.TotalCount})"
+
+ logger.info $"{labelTests} {parts} {totalStr}"
+ logger.info $"{labelStartAt} {startAt}"
+ logger.info $"{labelDuration} {durationStr}"
+ logger.info ""
+
+ /// The CI guard against committed ftest/ftestList. Runs whatever reporters are registered,
+ /// so that dropping the console reporter cannot silently drop the explanation for the
+ /// non-zero exit code.
+ let warnFocusedInCI (report: TestRunReport) : unit =
+ if isCI && report.AnyFocused then
+ logger.warning (
+ red "CI: focused tests detected - ftest/ftestList must not be committed."
+ )
+
+ logger.warning ""
+
+ let buildReport
+ (anyFocused: bool)
+ (startTime: System.DateTime)
+ (duration: int)
+ (results: TestResult list)
+ : TestRunReport
+ =
+ let countOf predicate =
+ results |> List.filter predicate |> List.length
+
+ let passed =
+ countOf (
+ function
+ | TestResult.Passed _ -> true
+ | _ -> false
+ )
+
+ let failed =
+ countOf (
+ function
+ | TestResult.Failed _ -> true
+ | _ -> false
+ )
+
+ let skipped =
+ countOf (
+ function
+ | TestResult.Skipped _ -> true
+ | _ -> false
+ )
+
+ let pending =
+ countOf (
+ function
+ | TestResult.Pending _ -> true
+ | _ -> false
+ )
+
+ {
+ Results = results
+ StartTime = startTime
+ Duration = duration
+ PassedCount = passed
+ FailedCount = failed
+ SkippedCount = skipped
+ PendingCount = pending
+ TotalCount = passed + failed + skipped + pending
+ AnyFocused = anyFocused
+ }
+
+ let notifyResult (reporters: Reporter list) (result: TestResult) : unit =
+ for reporter in reporters do
+ reporter.OnResult result
+
+ let notifyRunComplete (reporters: Reporter list) (report: TestRunReport) : unit =
+ for reporter in reporters do
+ reporter.OnRunComplete report
+
open Advanced
+[]
+module Reporters =
+
+ /// Writes the run to the terminal: a dot per result as it lands, then the result tree,
+ /// the summary, and the CI guard warning.
+ let console: Reporter =
+ {
+ OnResult = printDot
+ OnRunComplete = printRunReport
+ }
+
type Runner =
- static member runTestsWith(configurer: TestConfig -> TestConfig, tests: TestCase list) =
+ static member runTestsWith
+ (configurer: TestConfig -> TestConfig, reporters: Reporter list, tests: TestCase list)
+ =
initTerminal ()
let duplicates = findDuplicatePaths tests
@@ -536,101 +732,19 @@ type Runner =
let anyFocused = hasFocused tests
let sw = UniversalStopwatch()
let now = System.DateTime.Now
- let startAt = sprintf "%02d:%02d:%02d" now.Hour now.Minute now.Second
-
- let printDot result =
- match result with
- | TestResult.Passed r -> writeRaw (passedColor r "·")
- | TestResult.Failed _ -> writeRaw (red "x")
- | TestResult.Skipped _ -> writeRaw (dim "-")
- | TestResult.Pending _ -> writeRaw (yellow "*")
async {
- let! results = execute anyFocused globalConfig processorCount printDot tests
-
- logger.info ""
- logger.info ""
- printResults logger results
- logger.info ""
-
- let passed =
- results
- |> List.sumBy (
- function
- | TestResult.Passed _ -> 1
- | _ -> 0
- )
-
- let failed =
- results
- |> List.sumBy (
- function
- | TestResult.Failed _ -> 1
- | _ -> 0
- )
-
- let skipped =
- results
- |> List.sumBy (
- function
- | TestResult.Skipped _ -> 1
- | _ -> 0
- )
+ let! results =
+ execute anyFocused globalConfig processorCount (notifyResult reporters) tests
- let pending =
- results
- |> List.sumBy (
- function
- | TestResult.Pending _ -> 1
- | _ -> 0
- )
-
- let total = passed + failed + skipped + pending
-
- let totalMs = sw.ElapsedMs()
-
- let durationStr =
- if totalMs < 1000 then
- $"{totalMs}ms"
- else
- $"%.2f{(float totalMs / 1000.0)}s".Replace(".00s", "s")
-
- let parts =
- [
- if failed > 0 then
- red $"{failed} failed"
- if isCI && anyFocused then
- red "focused (not allowed in CI)"
- if passed > 0 then
- (green >> bold) $"{passed} passed"
- if skipped > 0 then
- dim $"{skipped} skipped"
- if pending > 0 then
- yellow $"{pending} pending"
- ]
- |> String.concat " | "
-
- let labelTests = dim ("Tests".PadLeft(9))
- let labelStartAt = dim ("Start at".PadLeft(9))
- let labelDuration = dim ("Duration".PadLeft(9))
- let totalStr = dim $"({total})"
-
- logger.info $"{labelTests} {parts} {totalStr}"
- logger.info $"{labelStartAt} {startAt}"
- logger.info $"{labelDuration} {durationStr}"
- logger.info ""
-
- if isCI && anyFocused then
- logger.warning (
- red "CI: focused tests detected - ftest/ftestList must not be committed."
- )
-
- logger.warning ""
+ let report = buildReport anyFocused now (sw.ElapsedMs()) results
+ notifyRunComplete reporters report
+ warnFocusedInCI report
let exitCode =
- if failed <> 0 then
+ if report.FailedCount <> 0 then
1
- else if isCI && anyFocused then
+ else if isCI && report.AnyFocused then
1
else
0
@@ -639,9 +753,25 @@ type Runner =
}
|> universalRunTests
+ static member runTestsWith
+ (configurer: TestConfig -> TestConfig, reporters: Reporter list, test: TestCase)
+ =
+ Runner.runTestsWith (configurer, reporters, [ test ])
+
+ static member runTestsWith(configurer: TestConfig -> TestConfig, tests: TestCase list) =
+ Runner.runTestsWith (configurer, [ Reporters.console ], tests)
+
static member runTestsWith(configurer: TestConfig -> TestConfig, test: TestCase) =
- Runner.runTestsWith (configurer, [ test ])
+ Runner.runTestsWith (configurer, [ Reporters.console ], [ test ])
+
+ static member runTests(reporters: Reporter list, tests: TestCase list) =
+ Runner.runTestsWith (id, reporters, tests)
+
+ static member runTests(reporters: Reporter list, test: TestCase) =
+ Runner.runTestsWith (id, reporters, [ test ])
- static member runTests(tests: TestCase list) = Runner.runTestsWith (id, tests)
+ static member runTests(tests: TestCase list) =
+ Runner.runTestsWith (id, [ Reporters.console ], tests)
- static member runTests(test: TestCase) = Runner.runTestsWith (id, [ test ])
+ static member runTests(test: TestCase) =
+ Runner.runTestsWith (id, [ Reporters.console ], [ test ])
diff --git a/src/Scriptorium.Quill/Types.fs b/src/Scriptorium.Quill/Types.fs
index 93704854..f92f0bc5 100644
--- a/src/Scriptorium.Quill/Types.fs
+++ b/src/Scriptorium.Quill/Types.fs
@@ -61,9 +61,34 @@ and [] TestCase =
| AsyncTest of TestDefinition Async>
| TestList of TestListDefinition
+/// Why a test was sidelined for this run.
+[]
+type SkipReason =
+ /// The effective configuration asked for it (e.g. skipIf, skipIfPython).
+ | Configured
+ /// Focus mode is active and this test is neither focused nor under a focused list.
+ | NotFocused
+
+type SkippedResult =
+ {
+ Path: string list
+ FilePath: string
+ LineNumber: int
+ Reason: SkipReason
+ }
+
+type PendingResult =
+ {
+ Path: string list
+ FilePath: string
+ LineNumber: int
+ }
+
type PassedResult =
{
Path: string list
+ FilePath: string
+ LineNumber: int
Duration: int
SlowThresholdMs: int
}
@@ -72,6 +97,10 @@ type FailedResult =
{
Path: string list
Message: string
+ /// Runtime type name of the exception, when the target can report one.
+ ExceptionType: string option
+ /// Stack trace of the exception, when the target records one.
+ StackTrace: string option
FilePath: string
LineNumber: int
Duration: int
@@ -82,5 +111,40 @@ type FailedResult =
type TestResult =
| Passed of PassedResult
| Failed of FailedResult
- | Skipped of path: string list // runtime/conditional skip (skipIf, focus mode)
- | Pending of path: string list // author-marked (xtest, todo)
+ | Skipped of SkippedResult // runtime/conditional skip (skipIf, focus mode)
+ | Pending of PendingResult // author-marked (xtest, todo)
+
+/// Everything a run produced: the individual results plus the run-level facts
+/// a report writer needs.
+type TestRunReport =
+ {
+ /// Results in declaration order.
+ Results: TestResult list
+ /// Wall-clock time the run started.
+ StartTime: System.DateTime
+ /// Total run duration in milliseconds.
+ Duration: int
+ PassedCount: int
+ FailedCount: int
+ SkippedCount: int
+ PendingCount: int
+ TotalCount: int
+ /// Whether any test or list in the run was focused.
+ AnyFocused: bool
+ }
+
+/// Observes a run
+type Reporter =
+ {
+ /// Called as each result is produced, in completion order. On BEAM this runs inside the
+ /// spawned job's process, so it can write output but cannot reach state owned by the run.
+ OnResult: TestResult -> unit
+ /// Called once when the run has finished, with the results in declaration order.
+ OnRunComplete: TestRunReport -> unit
+ }
+
+ static member Default =
+ {
+ OnResult = ignore
+ OnRunComplete = ignore
+ }
diff --git a/tests/Scriptorium.Quill.Test/Main.fs b/tests/Scriptorium.Quill.Test/Main.fs
index d960ade7..3c65d0d8 100644
--- a/tests/Scriptorium.Quill.Test/Main.fs
+++ b/tests/Scriptorium.Quill.Test/Main.fs
@@ -21,6 +21,8 @@ let private runToResultsWith
let private runToResults (tests: TestCase list) : Async = runToResultsWith id tests
+let private now = System.DateTime.Now
+
/// Run a list of TestCase trees under an explicit cap on how many run at once.
let private runToResultsBounded (maxParallel: int) (tests: TestCase list) : Async =
let anyFocused = Advanced.hasFocused tests
@@ -63,8 +65,8 @@ let private pathOf r =
match r with
| TestResult.Passed r -> List.rev r.Path
| TestResult.Failed r -> List.rev r.Path
- | TestResult.Skipped p -> List.rev p
- | TestResult.Pending p -> List.rev p
+ | TestResult.Skipped r -> List.rev r.Path
+ | TestResult.Pending r -> List.rev r.Path
let private durationOf r =
match r with
@@ -466,6 +468,317 @@ let main _ =
}
)
+ testAsync (
+ "Passed result carries caller info",
+ fun _ ->
+ async {
+ let! results = runToResults [ test ("ok", fun _ -> ()) ]
+
+ match results[0] with
+ | TestResult.Passed r ->
+ assertThat (r.FilePath.Length > 0) isTrue
+ assertThat (r.LineNumber > 0) isTrue
+ | other -> failwithf "Expected Passed, got %A" other
+ }
+ )
+
+ testAsync (
+ "Skipped result carries caller info",
+ fun _ ->
+ async {
+ let! results =
+ runToResults [ test ("skipped", skipIf true, fun _ -> ()) ]
+
+ match results[0] with
+ | TestResult.Skipped r ->
+ assertThat (r.FilePath.Length > 0) isTrue
+ assertThat (r.LineNumber > 0) isTrue
+ | other -> failwithf "Expected Skipped, got %A" other
+ }
+ )
+
+ testAsync (
+ "Pending result carries caller info",
+ fun _ ->
+ async {
+ let! results = runToResults [ xtest ("todo", fun _ -> ()) ]
+
+ match results[0] with
+ | TestResult.Pending r ->
+ assertThat (r.FilePath.Length > 0) isTrue
+ assertThat (r.LineNumber > 0) isTrue
+ | other -> failwithf "Expected Pending, got %A" other
+ }
+ )
+
+ testAsync (
+ "Pending result under an xtestList carries caller info",
+ fun _ ->
+ async {
+ let! results =
+ runToResults
+ [ xtestList ("list", [ test ("t", fun _ -> ()) ]) ]
+
+ match results[0] with
+ | TestResult.Pending r ->
+ assertThat (r.FilePath.Length > 0) isTrue
+ assertThat (r.LineNumber > 0) isTrue
+ | other -> failwithf "Expected Pending, got %A" other
+ }
+ )
+
+ ]
+ )
+
+ // ------------------------------------------------------------------
+ // Failure diagnostics
+ // ------------------------------------------------------------------
+
+ testList (
+ "failure diagnostics",
+ [
+
+ testAsync (
+ "Failed result names the exception type where the target reports one",
+ fun _ ->
+ async {
+ let! results =
+ runToResults [ test ("bad", fun _ -> failwith "boom") ]
+
+ match results[0] with
+ | TestResult.Failed r ->
+ match Prelude.currentPlatform with
+ | DotNet ->
+ assertThat
+ r.ExceptionType
+ (isEqualTo (Some "System.Exception"))
+ | JavaScript
+ | Python ->
+ assertThat
+ r.ExceptionType
+ (isEqualTo (Some "Exception"))
+ // Fable lowers every F# exception to a bare map with no
+ // type tag, so there is nothing to name.
+ | Beam -> assertThat r.ExceptionType Option.isNone
+ | other -> failwithf "Expected Failed, got %A" other
+ }
+ )
+
+ testAsync (
+ "Failed result carries a stack trace where the target records one",
+ fun _ ->
+ async {
+ let! results =
+ runToResults [ test ("bad", fun _ -> failwith "boom") ]
+
+ match results[0] with
+ | TestResult.Failed r ->
+ match Prelude.currentPlatform with
+ | DotNet
+ | Python -> assertThat r.StackTrace Option.isSome
+ // fable-library's Exception is not derived from Error, and
+ // the BEAM keeps the stacktrace on the catch clause.
+ | JavaScript
+ | Beam -> assertThat r.StackTrace Option.isNone
+ | other -> failwithf "Expected Failed, got %A" other
+ }
+ )
+
+ ]
+ )
+
+ // ------------------------------------------------------------------
+ // Reporters
+ // ------------------------------------------------------------------
+
+ testList (
+ "reporters",
+ [
+
+ testAsync (
+ "every registered reporter sees every result",
+ skipIfBeam,
+ fun _ ->
+ async {
+ let first = ResizeArray()
+ let second = ResizeArray()
+
+ let reporters =
+ [
+ { Reporter.Default with
+ OnResult = fun r -> first.Add r
+ }
+ { Reporter.Default with
+ OnResult = fun r -> second.Add r
+ }
+ ]
+
+ let! results =
+ Advanced.execute
+ false
+ TestConfig.Default
+ Prelude.processorCount
+ (Advanced.notifyResult reporters)
+ [
+ test ("a", fun _ -> ())
+ test ("b", fun _ -> failwith "boom")
+ ]
+
+ assertThat results.Length (isEqualTo 2)
+ assertThat first.Count (isEqualTo 2)
+ assertThat second.Count (isEqualTo 2)
+ }
+ )
+
+ testAsync (
+ "every registered reporter sees the run report",
+ fun _ ->
+ async {
+ let seen = ResizeArray()
+
+ let reporters =
+ [
+ { Reporter.Default with
+ OnRunComplete = fun r -> seen.Add r.TotalCount
+ }
+ { Reporter.Default with
+ OnRunComplete = fun r -> seen.Add(r.TotalCount * 10)
+ }
+ ]
+
+ let! results = runToResults [ test ("a", fun _ -> ()) ]
+ let report = Advanced.buildReport false now 0 results
+ Advanced.notifyRunComplete reporters report
+
+ assertThat
+ (List.ofSeq seen)
+ (isEqualTo
+ [
+ 1
+ 10
+ ])
+ }
+ )
+
+ testAsync (
+ "a reporter left at its default is a no-op",
+ fun _ ->
+ async {
+ let! results = runToResults [ test ("a", fun _ -> ()) ]
+ let report = Advanced.buildReport false now 0 results
+
+ Advanced.notifyResult [ Reporter.Default ] results[0]
+ Advanced.notifyRunComplete [ Reporter.Default ] report
+
+ assertThat results.Length (isEqualTo 1)
+ }
+ )
+
+ testAsync (
+ "the run report counts every outcome",
+ fun _ ->
+ async {
+ let! results =
+ runToResults
+ [
+ test ("pass", fun _ -> ())
+ test ("fail", fun _ -> failwith "boom")
+ test ("skip", skipIf true, fun _ -> ())
+ xtest ("todo", fun _ -> ())
+ ]
+
+ let report = Advanced.buildReport false now 42 results
+
+ assertThat report.PassedCount (isEqualTo 1)
+ assertThat report.FailedCount (isEqualTo 1)
+ assertThat report.SkippedCount (isEqualTo 1)
+ assertThat report.PendingCount (isEqualTo 1)
+ assertThat report.TotalCount (isEqualTo 4)
+ assertThat report.Duration (isEqualTo 42)
+ assertThat report.AnyFocused isFalse
+ }
+ )
+
+ testAsync (
+ "the run report records that the run was focused",
+ fun _ ->
+ async {
+ let tests =
+ [
+ ftest ("focused", fun _ -> ())
+ test ("sidelined", fun _ -> ())
+ ]
+
+ let anyFocused = Advanced.hasFocused tests
+ let! results = runToResults tests
+ let report = Advanced.buildReport anyFocused now 0 results
+
+ assertThat report.AnyFocused isTrue
+ assertThat report.Results.Length (isEqualTo 2)
+ }
+ )
+
+ ]
+ )
+
+ // ------------------------------------------------------------------
+ // Skip reason
+ // ------------------------------------------------------------------
+
+ testList (
+ "skip reason",
+ [
+
+ testAsync (
+ "a configured skip reports SkipReason.Configured",
+ fun _ ->
+ async {
+ let! results =
+ runToResults [ test ("s", skipIf true, fun _ -> ()) ]
+
+ match results[0] with
+ | TestResult.Skipped r ->
+ assertThat r.Reason (isEqualTo SkipReason.Configured)
+ | other -> failwithf "Expected Skipped, got %A" other
+ }
+ )
+
+ testAsync (
+ "a test sidelined by focus mode reports SkipReason.NotFocused",
+ fun _ ->
+ async {
+ let! results =
+ runToResults
+ [
+ ftest ("focused", fun _ -> ())
+ test ("sidelined", fun _ -> ())
+ ]
+
+ match results[1] with
+ | TestResult.Skipped r ->
+ assertThat r.Reason (isEqualTo SkipReason.NotFocused)
+ | other -> failwithf "Expected Skipped, got %A" other
+ }
+ )
+
+ testAsync (
+ "a configured skip wins over focus mode",
+ fun _ ->
+ async {
+ let! results =
+ runToResults
+ [
+ ftest ("focused", fun _ -> ())
+ test ("both", skipIf true, fun _ -> ())
+ ]
+
+ match results[1] with
+ | TestResult.Skipped r ->
+ assertThat r.Reason (isEqualTo SkipReason.Configured)
+ | other -> failwithf "Expected Skipped, got %A" other
+ }
+ )
+
]
)