From 1390037874b33264818089d27dfb9f48933147ea Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Fri, 2 Nov 2012 23:59:24 -0400 Subject: [PATCH] Use constants for passed, failed, et al. --- benchmarks.dylan | 8 ++++---- checks.dylan | 22 ++++++++++---------- components.dylan | 2 +- report/initialize.dylan | 4 ++-- report/log-reader.dylan | 10 +++++---- report/reports.dylan | 2 +- reports.dylan | 23 +++++++++++++-------- suites.dylan | 8 ++++---- tests.dylan | 8 ++++---- tests/testworks-test-suite.dylan | 35 ++++++++++++++++---------------- testworks-lib.dylan | 1 + testworks.dylan | 26 +++++++++++++++--------- 12 files changed, 82 insertions(+), 67 deletions(-) diff --git a/benchmarks.dylan b/benchmarks.dylan index 4eea72a..2795a6f 100644 --- a/benchmarks.dylan +++ b/benchmarks.dylan @@ -49,13 +49,13 @@ define method do-benchmark result := maybe-trap-errors(apply(function, arguments)); results status := if (~result) - #"failed" + $failed elseif (instance?(result, )) result else - #"passed" + $passed end if; - if (status == #"failed" & debug-failures?()) + if (status == $failed & debug-failures?()) break("Benchmark failed: %s", name) end if; record-benchmark(name, status, function, arguments, @@ -66,7 +66,7 @@ define method do-benchmark exception (r :: , init-arguments: vector(format-string:, "Skip this benchmark", format-arguments:, #[])) - #"failed" + $failed end block; end method do-benchmark; diff --git a/checks.dylan b/checks.dylan index f3d85f7..5b00d6c 100644 --- a/checks.dylan +++ b/checks.dylan @@ -113,13 +113,13 @@ define method do-check let result = maybe-trap-errors(apply(function, arguments)); let status :: = if (~result) - #"failed" + $failed elseif (instance?(result, )) result else - #"passed" + $passed end if; - if (status == #"failed" & debug-failures?()) + if (status == $failed & debug-failures?()) break("Check failed: %s", name) end if; record-check(name, status, function, arguments) @@ -127,7 +127,7 @@ define method do-check exception (r :: , init-arguments: vector(format-string:, "Skip this check", format-arguments:, #[])) - #"failed" + $failed end block; end method do-check; @@ -172,16 +172,16 @@ define method do-check-condition let handler condition-class = method (condition :: , next-handler :: ) ignore(condition, next-handler); - return(#"passed") + return($passed) end; body-of-check(); - #"failed" + $failed exception (r :: , init-arguments: vector(format-string:, "Skip this check", format-arguments:, #[])) - #"failed" + $failed end block; - if (result == #"failed" & debug-failures?()) + if (result == $failed & debug-failures?()) break("Check condition failed: %s (%s)", name, format-to-string("Expected %s to be signaled but got %s.", @@ -212,7 +212,7 @@ define method failure-reason end method failure-reason; define method failure-reason - (status == #"failed", + (status == $failed, operation :: , value :: ) => (reason :: false-or()) @@ -229,7 +229,7 @@ define method failure-reason end method failure-reason; define method failure-reason - (status == #"failed", + (status == $failed, operation :: subclass(), value :: ) => (reason :: false-or()) @@ -296,7 +296,7 @@ define method print-check-progress let status = result.result-status; let name = result.result-name; select (status) - #"not-executed" => + $skipped => test-output("Ignored check: %s", name); otherwise => test-output("Ran check: %s %s", name, status-name(status)); diff --git a/components.dylan b/components.dylan index 84a9b52..85d80bd 100644 --- a/components.dylan +++ b/components.dylan @@ -103,7 +103,7 @@ define method maybe-execute-component = if (execute-component?(component, options)) execute-component(component, options) else - values(#(), #"not-executed") + values(#(), $skipped) end; make-result(component, subresults, perform-status) end method maybe-execute-component; diff --git a/report/initialize.dylan b/report/initialize.dylan index e958f94..b1c5e54 100644 --- a/report/initialize.dylan +++ b/report/initialize.dylan @@ -349,12 +349,12 @@ define method find-named-result let passed? = every?(method (subresult) let status = subresult.result-status; - status = #"passed" | status = #"not-executed" + status = $passed | status = $skipped end, results); make(, name: "[Specified tests/suites]", - status: if (passed?) #"passed" else #"failed" end, + status: if (passed?) $passed else $failed end, subresults: results); end end method find-named-result; diff --git a/report/log-reader.dylan b/report/log-reader.dylan index 8783c7b..7649f82 100644 --- a/report/log-reader.dylan +++ b/report/log-reader.dylan @@ -12,14 +12,16 @@ define constant $testworks-message = "Make sure the test report was generated using the \"-report log\"\n" "or \"-report xml\" option to testworks."; +// It looks like this and testworks:status-name are meant to be +// inverses. define method parse-status (status-string :: , reason) select (status-string by \=) - "passed" => #"passed"; - "failed" => #"failed"; - "not executed" => #"not-executed"; + "passed" => $passed; + "failed" => $failed; + "not executed" => $skipped; "crashed" => recreate-error(reason); - "not implemented" => #"not-implemented"; + "not implemented" => $not-implemented; otherwise => error("Unexpected status '%s' in report", status-string); end diff --git a/report/reports.dylan b/report/reports.dylan index 37730c4..4c1f265 100644 --- a/report/reports.dylan +++ b/report/reports.dylan @@ -53,7 +53,7 @@ end method print-result-reason; define method print-result-reason (name :: , result :: , #key indent = "") => () - if (result.result-status ~== #"passed") + if (result.result-status ~== $passed) next-method(); else format-out("%s %s %s in %s seconds, %d bytes allocated\n", diff --git a/reports.dylan b/reports.dylan index 2af6f27..11b6657 100644 --- a/reports.dylan +++ b/reports.dylan @@ -55,11 +55,16 @@ define method count-results do-results (method (result) select (result.result-status) - #"passed" => passes := passes + 1; - #"failed" => failures := failures + 1; - #"not-executed" => not-executed := not-executed + 1; - #"not-implemented" => not-implemented := not-implemented + 1; - otherwise => crashes := crashes + 1; + $passed => + passes := passes + 1; + $failed => + failures := failures + 1; + $skipped => + not-executed := not-executed + 1; + $not-implemented => + not-implemented := not-implemented + 1; + otherwise => + crashes := crashes + 1; end end, result, @@ -184,7 +189,7 @@ define method print-benchmark-results let name = result-name(bench); let time = result-time(bench); let sbytes = result-bytes(bench) & integer-to-string(result-bytes(bench)); - if (result-status(bench) == #"passed") + if (result-status(bench) == $passed) let (newsec, newusec) = addtimes(seconds, microseconds, sec, usec); seconds := newsec; microseconds := newusec; @@ -263,7 +268,7 @@ define method print-result-info if (show-result?) test-output("\n%s%s %s", indent, result.result-name, status-name(result-status)); - if (result-status == #"passed" + if (result-status == $passed & instance?(result, )) test-output(" in %s seconds with %d bytes allocated.", result-time(result), result-bytes(result) | 0); @@ -306,14 +311,14 @@ end method summary-report-function; define method failures-report-function (result :: ) => () test-output("\n"); select (result.result-status) - #"passed" => + $passed => test-output("%s passed\n", result.result-name); otherwise => print-result-info (result, test: method (result) let status = result.result-status; - status ~== #"passed" & status ~== #"not-executed" + status ~== $passed & status ~== $skipped end); test-output("\n"); end; diff --git a/suites.dylan b/suites.dylan index fc803af..2228570 100644 --- a/suites.dylan +++ b/suites.dylan @@ -177,15 +177,15 @@ define method execute-component end; case empty?(subresults) => - #"not-implemented"; + $not-implemented; every?(method (subresult) let status = subresult.result-status; - status = #"passed" | status = #"not-executed" + status = $passed | status = $skipped end, subresults) => - #"passed"; + $passed; otherwise => - #"failed" + $failed end cleanup suite.suite-cleanup-function(); diff --git a/tests.dylan b/tests.dylan index 1812ee9..a1a4e96 100644 --- a/tests.dylan +++ b/tests.dylan @@ -186,14 +186,14 @@ define method execute-component instance?(cond, ) => cond; empty?(subresults) & ~test.test-allow-empty? => - #"not-implemented"; + $not-implemented; every?(method (result :: ) => (passed? :: ) - result.result-status == #"passed" + result.result-status == $passed end, subresults) => - #"passed"; + $passed; otherwise => - #"failed" + $failed end end; values(subresults, status) diff --git a/tests/testworks-test-suite.dylan b/tests/testworks-test-suite.dylan index b6df593..1523853 100644 --- a/tests/testworks-test-suite.dylan +++ b/tests/testworks-test-suite.dylan @@ -60,12 +60,12 @@ define test testworks-check-true-test () without-recording () check-true($internal-check-name, #t) end, - #"passed"); + $passed); check-equal("check-true(#f) fails", without-recording () check-true($internal-check-name, #f) end, - #"failed"); + $failed); check-true("check-true of error crashes", instance?(without-recording () check-true($internal-check-name, @@ -79,12 +79,12 @@ define test testworks-check-false-test () without-recording () check-false($internal-check-name, #t) end, - #"failed"); + $failed); check-equal("check-false(#f) passes", without-recording () check-false($internal-check-name, #f) end, - #"passed"); + $passed); check-true("check-false of error crashes", instance?(without-recording () check-false($internal-check-name, @@ -98,17 +98,17 @@ define test testworks-check-equal-test () without-recording () check-equal($internal-check-name, 1, 1) end, - #"passed"); + $passed); check-equal("check-equal(\"1\", \"1\") passes", without-recording () check-equal($internal-check-name, "1", "1") end, - #"passed"); + $passed); check-equal("check-equal(1, 2) fails", without-recording () check-equal($internal-check-name, 1, 2) end, - #"failed"); + $failed); check-true("check-equal of error crashes", instance?(without-recording () check-equal($internal-check-name, @@ -123,12 +123,12 @@ define test testworks-check-instance?-test () without-recording () check-instance?($internal-check-name, , 1) end, - #"passed"); + $passed); check-equal("check-instance?(1, ) fails", without-recording () check-instance?($internal-check-name, , 1) end, - #"failed"); + $failed); check-true("check-instance? of error crashes", instance?(without-recording () check-instance?($internal-check-name, @@ -151,7 +151,7 @@ define test testworks-check-condition-test () test-error() end) end, - #"passed"); + $passed); check-true("check-condition for doesn't catch ", success?); check-equal("check-condition fails if no condition", without-recording () @@ -159,7 +159,7 @@ define test testworks-check-condition-test () , #f) end, - #"failed"); + $failed); check-condition("check-condition doesn't catch wrong condition", , without-recording () @@ -174,12 +174,12 @@ define test testworks-check-no-errors-test () without-recording () check-no-errors($internal-check-name, #t) end, - #"passed"); + $passed); check-equal("check-no-errors of #f passes", without-recording () check-no-errors($internal-check-name, #f) end, - #"passed"); + $passed); check-true("check-no-errors of error crashes", instance?(without-recording () check-no-errors($internal-check-name, @@ -198,6 +198,7 @@ define suite testworks-check-macros-suite () test testworks-check-no-errors-test; end suite testworks-check-macros-suite; + /// Verify the result objects @@ -207,8 +208,8 @@ define test testworks-perform-test-results-test () = perform-test(test-to-check, progress-function: #f, report-function: #f); check-true("perform-test returns ", instance?(test-results, )); - check-equal("perform-test returns #\"passed\" when passing", - test-results.result-status, #"passed"); + check-equal("perform-test returns $passed when passing", + test-results.result-status, $passed); check-true("perform-test sub-results are in a vector", instance?(test-results.result-subresults, )) end test testworks-perform-test-results-test; @@ -219,8 +220,8 @@ define test testworks-perform-suite-results-test () = perform-suite(suite-to-check, progress-function: #f, report-function: #f); check-true("perform-suite returns ", instance?(suite-results, )); - check-equal("perform-suite returns #\"passed\" when passing", - suite-results.result-status, #"passed"); + check-equal("perform-suite returns $passed when passing", + suite-results.result-status, $passed); check-true("perform-suite sub-results are in a vector", instance?(suite-results.result-subresults, )) end test testworks-perform-suite-results-test; diff --git a/testworks-lib.dylan b/testworks-lib.dylan index b0d0bb9..fe0a739 100644 --- a/testworks-lib.dylan +++ b/testworks-lib.dylan @@ -96,6 +96,7 @@ define module testworks result-name, result-type-name, result-status, + $passed, $failed, $skipped, $not-implemented, $crashed, result-seconds, result-microseconds, result-time, diff --git a/testworks.dylan b/testworks.dylan index 8bed001..3bb0903 100644 --- a/testworks.dylan +++ b/testworks.dylan @@ -19,21 +19,27 @@ define constant /// Result handling +define constant $passed = #"passed"; +define constant $failed = #"failed"; +define constant $crashed = #"crashed"; +define constant $skipped = #"skipped"; +define constant $not-implemented = #"nyi"; + +// TODO(cgay): Get rid of type-union, just store the condition +// and use $crashed in the one-of. define constant - = type-union(one-of(#"passed", - #"failed", - #"not-executed", - #"not-implemented"), - ); + = type-union(one-of($passed, $failed, $skipped, $not-implemented), ); +// It looks like this and testworks-reports:parse-status are meant to +// be inverses. define method status-name (status :: ) => (name :: ) select (status) - #"passed" => "passed"; - #"failed" => "failed"; - #"not-executed" => "not executed"; - #"not-implemented" => "not implemented"; - otherwise => "crashed"; + $passed => "passed"; + $failed => "failed"; + $skipped => "skipped"; + $not-implemented => "not implemented"; + otherwise => "crashed"; end end method status-name;