Skip to content

Commit

Permalink
Use constants for passed, failed, et al.
Browse files Browse the repository at this point in the history
  • Loading branch information
@cgay
cgay committed Nov 3, 2012
1 parent e035b03 commit 1390037
Show file tree
Hide file tree
Showing 12 changed files with 82 additions and 67 deletions.
8 changes: 4 additions & 4 deletions benchmarks.dylan
View file
Expand Up @@ -49,13 +49,13 @@ define method do-benchmark
result := maybe-trap-errors(apply(function, arguments)); result := maybe-trap-errors(apply(function, arguments));
results results
status := if (~result) status := if (~result)
#"failed" $failed
elseif (instance?(result, <error>)) elseif (instance?(result, <error>))
result result
else else
#"passed" $passed
end if; end if;
if (status == #"failed" & debug-failures?()) if (status == $failed & debug-failures?())
break("Benchmark failed: %s", name) break("Benchmark failed: %s", name)
end if; end if;
record-benchmark(name, status, function, arguments, record-benchmark(name, status, function, arguments,
Expand All @@ -66,7 +66,7 @@ define method do-benchmark
exception (r :: <simple-restart>, exception (r :: <simple-restart>,
init-arguments: vector(format-string:, "Skip this benchmark", init-arguments: vector(format-string:, "Skip this benchmark",
format-arguments:, #[])) format-arguments:, #[]))
#"failed" $failed
end block; end block;
end method do-benchmark; end method do-benchmark;


Expand Down
22 changes: 11 additions & 11 deletions checks.dylan
View file
Expand Up @@ -113,21 +113,21 @@ define method do-check
let result = maybe-trap-errors(apply(function, arguments)); let result = maybe-trap-errors(apply(function, arguments));
let status :: <result-status> let status :: <result-status>
= if (~result) = if (~result)
#"failed" $failed
elseif (instance?(result, <error>)) elseif (instance?(result, <error>))
result result
else else
#"passed" $passed
end if; end if;
if (status == #"failed" & debug-failures?()) if (status == $failed & debug-failures?())
break("Check failed: %s", name) break("Check failed: %s", name)
end if; end if;
record-check(name, status, function, arguments) record-check(name, status, function, arguments)
end case; end case;
exception (r :: <simple-restart>, exception (r :: <simple-restart>,
init-arguments: vector(format-string:, "Skip this check", init-arguments: vector(format-string:, "Skip this check",
format-arguments:, #[])) format-arguments:, #[]))
#"failed" $failed
end block; end block;
end method do-check; end method do-check;


Expand Down Expand Up @@ -172,16 +172,16 @@ define method do-check-condition
let handler condition-class let handler condition-class
= method (condition :: <condition>, next-handler :: <function>) = method (condition :: <condition>, next-handler :: <function>)
ignore(condition, next-handler); ignore(condition, next-handler);
return(#"passed") return($passed)
end; end;
body-of-check(); body-of-check();
#"failed" $failed
exception (r :: <simple-restart>, exception (r :: <simple-restart>,
init-arguments: vector(format-string:, "Skip this check", init-arguments: vector(format-string:, "Skip this check",
format-arguments:, #[])) format-arguments:, #[]))
#"failed" $failed
end block; end block;
if (result == #"failed" & debug-failures?()) if (result == $failed & debug-failures?())
break("Check condition failed: %s (%s)", break("Check condition failed: %s (%s)",
name, name,
format-to-string("Expected %s to be signaled but got %s.", format-to-string("Expected %s to be signaled but got %s.",
Expand Down Expand Up @@ -212,7 +212,7 @@ define method failure-reason
end method failure-reason; end method failure-reason;


define method failure-reason define method failure-reason
(status == #"failed", (status == $failed,
operation :: <function>, operation :: <function>,
value :: <check-value-type>) value :: <check-value-type>)
=> (reason :: false-or(<string>)) => (reason :: false-or(<string>))
Expand All @@ -229,7 +229,7 @@ define method failure-reason
end method failure-reason; end method failure-reason;


define method failure-reason define method failure-reason
(status == #"failed", (status == $failed,
operation :: subclass(<condition>), operation :: subclass(<condition>),
value :: <check-value-type>) value :: <check-value-type>)
=> (reason :: false-or(<string>)) => (reason :: false-or(<string>))
Expand Down Expand Up @@ -296,7 +296,7 @@ define method print-check-progress
let status = result.result-status; let status = result.result-status;
let name = result.result-name; let name = result.result-name;
select (status) select (status)
#"not-executed" => $skipped =>
test-output("Ignored check: %s", name); test-output("Ignored check: %s", name);
otherwise => otherwise =>
test-output("Ran check: %s %s", name, status-name(status)); test-output("Ran check: %s %s", name, status-name(status));
Expand Down
2 changes: 1 addition & 1 deletion components.dylan
View file
Expand Up @@ -103,7 +103,7 @@ define method maybe-execute-component
= if (execute-component?(component, options)) = if (execute-component?(component, options))
execute-component(component, options) execute-component(component, options)
else else
values(#(), #"not-executed") values(#(), $skipped)
end; end;
make-result(component, subresults, perform-status) make-result(component, subresults, perform-status)
end method maybe-execute-component; end method maybe-execute-component;
4 changes: 2 additions & 2 deletions report/initialize.dylan
View file
Expand Up @@ -349,12 +349,12 @@ define method find-named-result
let passed? let passed?
= every?(method (subresult) = every?(method (subresult)
let status = subresult.result-status; let status = subresult.result-status;
status = #"passed" | status = #"not-executed" status = $passed | status = $skipped
end, end,
results); results);
make(<suite-result>, make(<suite-result>,
name: "[Specified tests/suites]", name: "[Specified tests/suites]",
status: if (passed?) #"passed" else #"failed" end, status: if (passed?) $passed else $failed end,
subresults: results); subresults: results);
end end
end method find-named-result; end method find-named-result;
Expand Down
10 changes: 6 additions & 4 deletions report/log-reader.dylan
View file
Expand Up @@ -12,14 +12,16 @@ define constant $testworks-message
= "Make sure the test report was generated using the \"-report log\"\n" = "Make sure the test report was generated using the \"-report log\"\n"
"or \"-report xml\" option to testworks."; "or \"-report xml\" option to testworks.";


// It looks like this and testworks:status-name are meant to be
// inverses.
define method parse-status define method parse-status
(status-string :: <string>, reason) (status-string :: <string>, reason)
select (status-string by \=) select (status-string by \=)
"passed" => #"passed"; "passed" => $passed;
"failed" => #"failed"; "failed" => $failed;
"not executed" => #"not-executed"; "not executed" => $skipped;
"crashed" => recreate-error(reason); "crashed" => recreate-error(reason);
"not implemented" => #"not-implemented"; "not implemented" => $not-implemented;
otherwise => otherwise =>
error("Unexpected status '%s' in report", status-string); error("Unexpected status '%s' in report", status-string);
end end
Expand Down
2 changes: 1 addition & 1 deletion report/reports.dylan
View file
Expand Up @@ -53,7 +53,7 @@ end method print-result-reason;


define method print-result-reason define method print-result-reason
(name :: <string>, result :: <benchmark-result>, #key indent = "") => () (name :: <string>, result :: <benchmark-result>, #key indent = "") => ()
if (result.result-status ~== #"passed") if (result.result-status ~== $passed)
next-method(); next-method();
else else
format-out("%s %s %s in %s seconds, %d bytes allocated\n", format-out("%s %s %s in %s seconds, %d bytes allocated\n",
Expand Down
23 changes: 14 additions & 9 deletions reports.dylan
View file
Expand Up @@ -55,11 +55,16 @@ define method count-results
do-results do-results
(method (result) (method (result)
select (result.result-status) select (result.result-status)
#"passed" => passes := passes + 1; $passed =>
#"failed" => failures := failures + 1; passes := passes + 1;
#"not-executed" => not-executed := not-executed + 1; $failed =>
#"not-implemented" => not-implemented := not-implemented + 1; failures := failures + 1;
otherwise => crashes := crashes + 1; $skipped =>
not-executed := not-executed + 1;
$not-implemented =>
not-implemented := not-implemented + 1;
otherwise =>
crashes := crashes + 1;
end end
end, end,
result, result,
Expand Down Expand Up @@ -184,7 +189,7 @@ define method print-benchmark-results
let name = result-name(bench); let name = result-name(bench);
let time = result-time(bench); let time = result-time(bench);
let sbytes = result-bytes(bench) & integer-to-string(result-bytes(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); let (newsec, newusec) = addtimes(seconds, microseconds, sec, usec);
seconds := newsec; seconds := newsec;
microseconds := newusec; microseconds := newusec;
Expand Down Expand Up @@ -263,7 +268,7 @@ define method print-result-info
if (show-result?) if (show-result?)
test-output("\n%s%s %s", test-output("\n%s%s %s",
indent, result.result-name, status-name(result-status)); indent, result.result-name, status-name(result-status));
if (result-status == #"passed" if (result-status == $passed
& instance?(result, <benchmark-result>)) & instance?(result, <benchmark-result>))
test-output(" in %s seconds with %d bytes allocated.", test-output(" in %s seconds with %d bytes allocated.",
result-time(result), result-bytes(result) | 0); result-time(result), result-bytes(result) | 0);
Expand Down Expand Up @@ -306,14 +311,14 @@ end method summary-report-function;
define method failures-report-function (result :: <result>) => () define method failures-report-function (result :: <result>) => ()
test-output("\n"); test-output("\n");
select (result.result-status) select (result.result-status)
#"passed" => $passed =>
test-output("%s passed\n", result.result-name); test-output("%s passed\n", result.result-name);
otherwise => otherwise =>
print-result-info print-result-info
(result, (result,
test: method (result) test: method (result)
let status = result.result-status; let status = result.result-status;
status ~== #"passed" & status ~== #"not-executed" status ~== $passed & status ~== $skipped
end); end);
test-output("\n"); test-output("\n");
end; end;
Expand Down
8 changes: 4 additions & 4 deletions suites.dylan
View file
Expand Up @@ -177,15 +177,15 @@ define method execute-component
end; end;
case case
empty?(subresults) => empty?(subresults) =>
#"not-implemented"; $not-implemented;
every?(method (subresult) every?(method (subresult)
let status = subresult.result-status; let status = subresult.result-status;
status = #"passed" | status = #"not-executed" status = $passed | status = $skipped
end, end,
subresults) => subresults) =>
#"passed"; $passed;
otherwise => otherwise =>
#"failed" $failed
end end
cleanup cleanup
suite.suite-cleanup-function(); suite.suite-cleanup-function();
Expand Down
8 changes: 4 additions & 4 deletions tests.dylan
View file
Expand Up @@ -186,14 +186,14 @@ define method execute-component
instance?(cond, <serious-condition>) => instance?(cond, <serious-condition>) =>
cond; cond;
empty?(subresults) & ~test.test-allow-empty? => empty?(subresults) & ~test.test-allow-empty? =>
#"not-implemented"; $not-implemented;
every?(method (result :: <unit-result>) => (passed? :: <boolean>) every?(method (result :: <unit-result>) => (passed? :: <boolean>)
result.result-status == #"passed" result.result-status == $passed
end, end,
subresults) => subresults) =>
#"passed"; $passed;
otherwise => otherwise =>
#"failed" $failed
end end
end; end;
values(subresults, status) values(subresults, status)
Expand Down
35 changes: 18 additions & 17 deletions tests/testworks-test-suite.dylan
View file
Expand Up @@ -60,12 +60,12 @@ define test testworks-check-true-test ()
without-recording () without-recording ()
check-true($internal-check-name, #t) check-true($internal-check-name, #t)
end, end,
#"passed"); $passed);
check-equal("check-true(#f) fails", check-equal("check-true(#f) fails",
without-recording () without-recording ()
check-true($internal-check-name, #f) check-true($internal-check-name, #f)
end, end,
#"failed"); $failed);
check-true("check-true of error crashes", check-true("check-true of error crashes",
instance?(without-recording () instance?(without-recording ()
check-true($internal-check-name, check-true($internal-check-name,
Expand All @@ -79,12 +79,12 @@ define test testworks-check-false-test ()
without-recording () without-recording ()
check-false($internal-check-name, #t) check-false($internal-check-name, #t)
end, end,
#"failed"); $failed);
check-equal("check-false(#f) passes", check-equal("check-false(#f) passes",
without-recording () without-recording ()
check-false($internal-check-name, #f) check-false($internal-check-name, #f)
end, end,
#"passed"); $passed);
check-true("check-false of error crashes", check-true("check-false of error crashes",
instance?(without-recording () instance?(without-recording ()
check-false($internal-check-name, check-false($internal-check-name,
Expand All @@ -98,17 +98,17 @@ define test testworks-check-equal-test ()
without-recording () without-recording ()
check-equal($internal-check-name, 1, 1) check-equal($internal-check-name, 1, 1)
end, end,
#"passed"); $passed);
check-equal("check-equal(\"1\", \"1\") passes", check-equal("check-equal(\"1\", \"1\") passes",
without-recording () without-recording ()
check-equal($internal-check-name, "1", "1") check-equal($internal-check-name, "1", "1")
end, end,
#"passed"); $passed);
check-equal("check-equal(1, 2) fails", check-equal("check-equal(1, 2) fails",
without-recording () without-recording ()
check-equal($internal-check-name, 1, 2) check-equal($internal-check-name, 1, 2)
end, end,
#"failed"); $failed);
check-true("check-equal of error crashes", check-true("check-equal of error crashes",
instance?(without-recording () instance?(without-recording ()
check-equal($internal-check-name, check-equal($internal-check-name,
Expand All @@ -123,12 +123,12 @@ define test testworks-check-instance?-test ()
without-recording () without-recording ()
check-instance?($internal-check-name, <integer>, 1) check-instance?($internal-check-name, <integer>, 1)
end, end,
#"passed"); $passed);
check-equal("check-instance?(1, <string>) fails", check-equal("check-instance?(1, <string>) fails",
without-recording () without-recording ()
check-instance?($internal-check-name, <string>, 1) check-instance?($internal-check-name, <string>, 1)
end, end,
#"failed"); $failed);
check-true("check-instance? of error crashes", check-true("check-instance? of error crashes",
instance?(without-recording () instance?(without-recording ()
check-instance?($internal-check-name, check-instance?($internal-check-name,
Expand All @@ -151,15 +151,15 @@ define test testworks-check-condition-test ()
test-error() test-error()
end) end)
end, end,
#"passed"); $passed);
check-true("check-condition for <error> doesn't catch <warning>", success?); check-true("check-condition for <error> doesn't catch <warning>", success?);
check-equal("check-condition fails if no condition", check-equal("check-condition fails if no condition",
without-recording () without-recording ()
check-condition($internal-check-name, check-condition($internal-check-name,
<test-error>, <test-error>,
#f) #f)
end, end,
#"failed"); $failed);
check-condition("check-condition doesn't catch wrong condition", check-condition("check-condition doesn't catch wrong condition",
<warning>, <warning>,
without-recording () without-recording ()
Expand All @@ -174,12 +174,12 @@ define test testworks-check-no-errors-test ()
without-recording () without-recording ()
check-no-errors($internal-check-name, #t) check-no-errors($internal-check-name, #t)
end, end,
#"passed"); $passed);
check-equal("check-no-errors of #f passes", check-equal("check-no-errors of #f passes",
without-recording () without-recording ()
check-no-errors($internal-check-name, #f) check-no-errors($internal-check-name, #f)
end, end,
#"passed"); $passed);
check-true("check-no-errors of error crashes", check-true("check-no-errors of error crashes",
instance?(without-recording () instance?(without-recording ()
check-no-errors($internal-check-name, check-no-errors($internal-check-name,
Expand All @@ -198,6 +198,7 @@ define suite testworks-check-macros-suite ()
test testworks-check-no-errors-test; test testworks-check-no-errors-test;
end suite testworks-check-macros-suite; end suite testworks-check-macros-suite;





/// Verify the result objects /// Verify the result objects


Expand All @@ -207,8 +208,8 @@ define test testworks-perform-test-results-test ()
= perform-test(test-to-check, progress-function: #f, report-function: #f); = perform-test(test-to-check, progress-function: #f, report-function: #f);
check-true("perform-test returns <test-result>", check-true("perform-test returns <test-result>",
instance?(test-results, <test-result>)); instance?(test-results, <test-result>));
check-equal("perform-test returns #\"passed\" when passing", check-equal("perform-test returns $passed when passing",
test-results.result-status, #"passed"); test-results.result-status, $passed);
check-true("perform-test sub-results are in a vector", check-true("perform-test sub-results are in a vector",
instance?(test-results.result-subresults, <vector>)) instance?(test-results.result-subresults, <vector>))
end test testworks-perform-test-results-test; end test testworks-perform-test-results-test;
Expand All @@ -219,8 +220,8 @@ define test testworks-perform-suite-results-test ()
= perform-suite(suite-to-check, progress-function: #f, report-function: #f); = perform-suite(suite-to-check, progress-function: #f, report-function: #f);
check-true("perform-suite returns <suite-result>", check-true("perform-suite returns <suite-result>",
instance?(suite-results, <suite-result>)); instance?(suite-results, <suite-result>));
check-equal("perform-suite returns #\"passed\" when passing", check-equal("perform-suite returns $passed when passing",
suite-results.result-status, #"passed"); suite-results.result-status, $passed);
check-true("perform-suite sub-results are in a vector", check-true("perform-suite sub-results are in a vector",
instance?(suite-results.result-subresults, <vector>)) instance?(suite-results.result-subresults, <vector>))
end test testworks-perform-suite-results-test; end test testworks-perform-suite-results-test;
Expand Down
1 change: 1 addition & 0 deletions testworks-lib.dylan
View file
Expand Up @@ -96,6 +96,7 @@ define module testworks
result-name, result-name,
result-type-name, result-type-name,
result-status, result-status,
$passed, $failed, $skipped, $not-implemented, $crashed,
result-seconds, result-seconds,
result-microseconds, result-microseconds,
result-time, result-time,
Expand Down

0 comments on commit 1390037

Please sign in to comment.