Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Use constants for passed, failed, et al. #3

Merged
merged 2 commits into from

2 participants

@cgay
Owner

No description provided.

@waywardmonkeys

No reason for this to not just be #"not-implemented" is there? (I'll merge it anyway, but might be worth fixing later.)

@waywardmonkeys

As a future cleanup, perhaps move them to be next to each other here?

@waywardmonkeys waywardmonkeys merged commit bf5f0ff into dylan-lang:master
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Nov 3, 2012
  1. @cgay
  2. @cgay

    not executed -> skipped

    cgay authored
This page is out of date. Refresh to see the latest.
View
8 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, <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
22 checks.dylan
@@ -113,13 +113,13 @@ 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)
@@ -127,7 +127,7 @@ define method do-check
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
2  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;
View
4 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(<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 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 :: <string>, reason)
select (status-string by \=)
- "passed" => #"passed";
- "failed" => #"failed";
- "not executed" => #"not-executed";
- "crashed" => recreate-error(reason);
- "not implemented" => #"not-implemented";
+ "passed" => $passed;
+ "failed" => $failed;
+ "skipped" => $skipped;
+ "crashed" => recreate-error(reason);
+ "not implemented" => $not-implemented;
otherwise =>
error("Unexpected status '%s' in report", status-string);
end
View
2  report/reports.dylan
@@ -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
25 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;
@@ -243,7 +248,7 @@ define method print-result-summary
if (total-results == 1) ": " else "s: " end,
passes);
print-percentage(passes, total-results);
- test-output("), %d failed, %d not executed, %d not implemented, %d crashed\n",
+ test-output("), %d failed, %d skipped, %d not implemented, %d crashed\n",
failures, not-executed, not-implemented, crashes);
end method print-result-summary;
@@ -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
8 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();
View
8 tests.dylan
@@ -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)
View
35 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, <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,7 +151,7 @@ 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 ()
@@ -159,7 +159,7 @@ define test testworks-check-condition-test ()
<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
1  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,
View
26 testworks.dylan
@@ -19,21 +19,27 @@ define constant <check-value-type>
/// 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 <result-status>
- = type-union(one-of(#"passed",
- #"failed",
- #"not-executed",
- #"not-implemented"),
- <condition>);
+ = type-union(one-of($passed, $failed, $skipped, $not-implemented), <condition>);
+// It looks like this and testworks-reports:parse-status are meant to
+// be inverses.
define method status-name
(status :: <result-status>) => (name :: <string>)
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;
Something went wrong with that request. Please try again.