Permalink
Browse files

Use constants for passed, failed, et al.

  • Loading branch information...
1 parent e035b03 commit 1390037874b33264818089d27dfb9f48933147ea @cgay cgay committed Nov 3, 2012
Showing with 82 additions and 67 deletions.
  1. +4 −4 benchmarks.dylan
  2. +11 −11 checks.dylan
  3. +1 −1 components.dylan
  4. +2 −2 report/initialize.dylan
  5. +6 −4 report/log-reader.dylan
  6. +1 −1 report/reports.dylan
  7. +14 −9 reports.dylan
  8. +4 −4 suites.dylan
  9. +4 −4 tests.dylan
  10. +18 −17 tests/testworks-test-suite.dylan
  11. +1 −0 testworks-lib.dylan
  12. +16 −10 testworks.dylan
View
@@ -49,13 +49,13 @@ define method do-benchmark
result := maybe-trap-errors(apply(function, arguments));
results
status := if (~result)
- #"failed"
+ $failed
elseif (instance?(result, <error>))
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 :: <simple-restart>,
init-arguments: vector(format-string:, "Skip this benchmark",
format-arguments:, #[]))
- #"failed"
+ $failed
end block;
end method do-benchmark;
View
@@ -113,21 +113,21 @@ define method do-check
let result = maybe-trap-errors(apply(function, arguments));
let status :: <result-status>
= if (~result)
- #"failed"
+ $failed
elseif (instance?(result, <error>))
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)
end case;
exception (r :: <simple-restart>,
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 :: <condition>, next-handler :: <function>)
ignore(condition, next-handler);
- return(#"passed")
+ return($passed)
end;
body-of-check();
- #"failed"
+ $failed
exception (r :: <simple-restart>,
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 :: <function>,
value :: <check-value-type>)
=> (reason :: false-or(<string>))
@@ -229,7 +229,7 @@ define method failure-reason
end method failure-reason;
define method failure-reason
- (status == #"failed",
+ (status == $failed,
operation :: subclass(<condition>),
value :: <check-value-type>)
=> (reason :: false-or(<string>))
@@ -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));
View
@@ -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;
View
@@ -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(<suite-result>,
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;
View
@@ -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 :: <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
View
@@ -53,7 +53,7 @@ end method print-result-reason;
define method print-result-reason
(name :: <string>, result :: <benchmark-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",
View
@@ -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, <benchmark-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 :: <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;
View
@@ -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();
View
@@ -186,14 +186,14 @@ define method execute-component
instance?(cond, <serious-condition>) =>
cond;
empty?(subresults) & ~test.test-allow-empty? =>
- #"not-implemented";
+ $not-implemented;
every?(method (result :: <unit-result>) => (passed? :: <boolean>)
- result.result-status == #"passed"
+ result.result-status == $passed
end,
subresults) =>
- #"passed";
+ $passed;
otherwise =>
- #"failed"
+ $failed
end
end;
values(subresults, status)
@@ -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, <integer>, 1)
end,
- #"passed");
+ $passed);
check-equal("check-instance?(1, <string>) fails",
without-recording ()
check-instance?($internal-check-name, <string>, 1)
end,
- #"failed");
+ $failed);
check-true("check-instance? of error crashes",
instance?(without-recording ()
check-instance?($internal-check-name,
@@ -151,15 +151,15 @@ define test testworks-check-condition-test ()
test-error()
end)
end,
- #"passed");
+ $passed);
check-true("check-condition for <error> doesn't catch <warning>", success?);
check-equal("check-condition fails if no condition",
without-recording ()
check-condition($internal-check-name,
<test-error>,
#f)
end,
- #"failed");
+ $failed);
check-condition("check-condition doesn't catch wrong condition",
<warning>,
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 <test-result>",
instance?(test-results, <test-result>));
- 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, <vector>))
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 <suite-result>",
instance?(suite-results, <suite-result>));
- 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, <vector>))
end test testworks-perform-suite-results-test;
View
@@ -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,
Oops, something went wrong.

0 comments on commit 1390037

Please sign in to comment.