From d8d9a07bb82438dcc72ffe27936a1629c3689c82 Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Fri, 13 Oct 2023 06:01:40 +0000 Subject: [PATCH] Display correct suite status If all subresults are SKIPPED the suite result is SKIPPED, etc. If there is a mix of result types, * display CRASHED if any crashed * display PASSED if none failed * else display FAILED --- library.dylan | 4 +- run.dylan | 89 +++++++++++++++++--------------- tests/testworks-test-suite.dylan | 44 +++++++++++++--- 3 files changed, 87 insertions(+), 50 deletions(-) diff --git a/library.dylan b/library.dylan index aaa7417..de7c3d6 100644 --- a/library.dylan +++ b/library.dylan @@ -175,6 +175,8 @@ define module %testworks result-microseconds, result-time, result-bytes, + result-reason, + result-passing?, , result-subresults, @@ -184,8 +186,8 @@ define module %testworks , , , - result-reason, do-results, + decide-suite-status, ; // Report functions diff --git a/run.dylan b/run.dylan index 75e4996..1af0b00 100644 --- a/run.dylan +++ b/run.dylan @@ -159,48 +159,34 @@ define method execute-component let microseconds :: = 0; let bytes :: = 0; let indent = next-indent(); - let status - = block () - suite.suite-setup-function(); - for (component in sort-components(suite.suite-components, runner.runner-order)) - let subresult - = dynamic-bind (*indent* = indent) - maybe-execute-component(component, runner); - end; - add!(subresults, subresult); - if (instance?(subresult, ) - & subresult.result-seconds - & subresult.result-microseconds) - let (sec, usec) = add-times(seconds, microseconds, - subresult.result-seconds, - subresult.result-microseconds); - seconds := sec; - microseconds := usec; - bytes := bytes + subresult.result-bytes; - else - test-output("subresult has no profiling info: %s\n", - subresult.result-name); + block () + suite.suite-setup-function(); + for (component in sort-components(suite.suite-components, runner.runner-order)) + let subresult + = dynamic-bind (*indent* = indent) + maybe-execute-component(component, runner); end; - end for; - case - // If all subcomponents are unimplemented the suite is unimplemented. - // Note that this case matches when subresults are empty. - every?(method (subresult) - subresult.result-status = $not-implemented - end, - subresults) - => $not-implemented; - every?(result-passing?, subresults) - => $passed; - otherwise - => $failed; - end case - cleanup - suite.suite-cleanup-function(); - end block; + add!(subresults, subresult); + if (instance?(subresult, ) + & subresult.result-seconds + & subresult.result-microseconds) + let (sec, usec) = add-times(seconds, microseconds, + subresult.result-seconds, + subresult.result-microseconds); + seconds := sec; + microseconds := usec; + bytes := bytes + subresult.result-bytes; + else + test-output("subresult has no profiling info: %s\n", + subresult.result-name); + end; + end for; + cleanup + suite.suite-cleanup-function(); + end block; make(component-result-type(suite), name: suite.component-name, - status: status, + status: decide-suite-status(subresults), reason: #f, subresults: subresults, seconds: seconds, @@ -208,6 +194,27 @@ define method execute-component bytes: bytes) end method execute-component; +define function decide-suite-status + (subresults :: ) => (status :: ) + if (empty?(subresults)) + $not-implemented + else + let status0 = subresults[0].result-status; + if (every?(method (subresult) + subresult.result-status == status0 + end, + subresults)) + status0 + elseif (any?(method (r) r.result-status == $crashed end, subresults)) + $crashed + elseif (every?(result-passing?, subresults)) + $passed + else + $failed + end if + end if +end function; + define method execute-component (test :: , runner :: ) => (result :: ) @@ -248,7 +255,7 @@ define method execute-component microseconds := cpu-time-microseconds; bytes := allocation; end profiling; - decide-status(test, subresults, cond) + decide-test-status(test, subresults, cond) end dynamic-bind; make(component-result-type(test), name: test.component-name, @@ -260,7 +267,7 @@ define method execute-component bytes: bytes) end method execute-component; -define function decide-status +define function decide-test-status (test :: , subresults, condition) => (status :: , reason) let benchmark? = ~test.test-requires-assertions?; diff --git a/tests/testworks-test-suite.dylan b/tests/testworks-test-suite.dylan index e53349f..a0c1c12 100644 --- a/tests/testworks-test-suite.dylan +++ b/tests/testworks-test-suite.dylan @@ -420,14 +420,10 @@ define constant unexpected-success-suite define test test-run-tests-expect-failure/suite () let runner = make(, progress: $progress-none); - - let suite-results = run-tests(runner, expected-to-fail-suite); - assert-equal($passed, suite-results.result-status, - "expected-to-fail-suite should pass because all of its tests" - " fail and are expected to fail"); - - let suite-results = run-tests(runner, unexpected-success-suite); - assert-equal($failed, suite-results.result-status, + assert-true(result-passing?(run-tests(runner, expected-to-fail-suite)), + "expected-to-fail-suite should pass because all of its tests" + " fail and are expected to fail"); + assert-false(result-passing?(run-tests(runner, unexpected-success-suite)), "unexpected-success-suite should fail because its tests" " pass but are expected to fail"); end test; @@ -743,6 +739,38 @@ define test test-check-equal-failure-detail () "sizes differ (4 and 5)"); end test; +define test test-decide-suite-status () + assert-equal($not-implemented, decide-suite-status(#[])); + let v = vector; + for (item in v(// First the simple one-subresult cases... + v($passed, v($passed)), + v($failed, v($failed)), + v($crashed, v($crashed)), + v($skipped, v($skipped)), + v($expected-failure, v($expected-failure)), + v($unexpected-success, v($unexpected-success)), + v($not-implemented, v($not-implemented)), + // Now a few combinations... + v($failed, v($passed, $failed)), + v($failed, v($passed, $unexpected-success)), + v($passed, v($passed, $expected-failure, $skipped, $not-implemented)), + v($crashed, v($crashed, $failed)), + v($failed, v($unexpected-success, $failed)))) + let (expected-status, subresult-statuses) + = apply(values, item); + let subresults = map(method (status) + make(, + status: status, + name: status-name(status)) + end, + subresult-statuses); + assert-equal(expected-status, + decide-suite-status(subresults), + format-to-string("%= == decide-suite-status(%=)", + expected-status, subresult-statuses)); + end for; +end test; + /* Leaving this here because actually running these failing checks makes it much easier to debug, compared to running the above test, and there's more work to be done in this area so I expect to use these more.