Skip to content

Commit

Permalink
Merge pull request dylan-lang#163 from cgay/dev
Browse files Browse the repository at this point in the history 
Various output improvements
  • Loading branch information
@cgay
cgay authored Oct 13, 2023
2 parents 5aa98e6 + d8d9a07 commit 349cfab
Show file tree
Hide file tree
Showing 6 changed files with 169 additions and 130 deletions.
16 changes: 8 additions & 8 deletions README.md
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
# Testworks

Testworks is a Dylan unit testing library.
Testworks is a Dylan unit testing library, also with simple benchmarking
support.

Testworks is included by
[dylan-tool](https://opendylan.org/package/dylan-tool/) as a developer
dependency in every project created.
Testworks is included as a developer dependency in every project created by
[dylan-tool](https://opendylan.org/package/dylan-tool/).

Documentation is available in
[Opendylan.org](https://opendylan.org/package/testworks/). To build
the documentation locally, you'll need the
[furo](https://sphinx-themes.org/sample-sites/furo/) theme.
Documentation is available on
[opendylan.org](https://opendylan.org/package/testworks/). To build the
documentation locally, you'll need the
[furo](https://sphinx-themes.org/sample-sites/furo/) theme.
4 changes: 2 additions & 2 deletions components.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -208,7 +208,7 @@ end macro suite-definer;
define macro test-definer
{ define test ?test-name:name (?keyword-args:*) ?test-body:body end
} => {
define function "%%" ## ?test-name () ?test-body end;
define function "%%" ## ?test-name () => () ?test-body end;
define constant ?test-name = make(<test>,
name: ?"test-name",
function: "%%" ## ?test-name,
Expand All @@ -220,7 +220,7 @@ end macro test-definer;
define macro benchmark-definer
{ define benchmark ?test-name:name (?keyword-args:*) ?test-body:body end
} => {
define function "%%" ## ?test-name () ?test-body end;
define function "%%" ## ?test-name () => () ?test-body end;
define constant ?test-name :: <benchmark>
= make(<benchmark>,
name: ?"test-name",
Expand Down
4 changes: 3 additions & 1 deletion library.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -175,6 +175,8 @@ define module %testworks
result-microseconds,
result-time,
result-bytes,
result-reason,
result-passing?,

<component-result>,
result-subresults,
Expand All @@ -184,8 +186,8 @@ define module %testworks
<benchmark-result>,
<benchmark-iteration-result>,
<suite-result>,
result-reason,
do-results,
decide-suite-status,
<check-result>;

// Report functions
Expand Down
170 changes: 59 additions & 111 deletions run.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,67 +10,6 @@ Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
// test/benchmark execution and while setup/teardown code is running.
define thread variable *component* :: false-or(<component>) = #f;

// Return a temporary directory unique to the current test or benchmark. The
// directory is created the first time this is called for a given test.
// The directory is _test/<user>-<yyyymmdd-hhmmss>/<full-test-name>/, relative
// to ${DYLAN}/, if defined, or relative to fs/working-directory() otherwise.
define function test-temp-directory () => (d :: false-or(<directory-locator>))
if (instance?(*component*, <runnable>))
let dylan = os/environment-variable("DYLAN");
let base = if (dylan)
as(<directory-locator>, dylan)
else
fs/working-directory()
end;
let uniquifier
= format-to-string("%s-%s", os/login-name() | "unknown",
date/format("%Y%m%d-%H%M%S", date/now()));
let safe-name = map(method (c)
if (c == '\\' | c == '/') '_' else c end
end,
full-component-name(*component*));
let test-directory
= subdirectory-locator(base, "_test", uniquifier, safe-name);
fs/ensure-directories-exist(test-directory);
test-directory
end
end function;

// Create a file in the current test's temp directory with the given contents.
// If the file already exists an error is signaled. `filename` is assumed to be
// a relative pathname; if it contains the path separator, subdirectories are
// created. File contents may be provided with the `contents` parameter,
// otherwise an empty file is created. Returns the full, absolute file path as
// a `<file-locator>`.
define function write-test-file
(filename :: fs/<pathname>, #key contents :: <string> = "")
=> (full-pathname :: <file-locator>)
let locator = merge-locators(as(<file-locator>, filename),
test-temp-directory());
fs/ensure-directories-exist(locator);
fs/with-open-file (stream = locator,
direction: #"output", if-exists: #"signal")
write(stream, contents);
end;
locator
end function;

// For tests to do debugging output.
// TODO(cgay): Collect this and stdio into a log file per test run
// or per test. The Surefire report has a place for stdout, too.
define method test-output
(format-string :: <string>, #rest format-args) => ()
let stream = if (*runner*)
runner-output-stream(*runner*)
else
*standard-output*
end;
with-stream-locked (stream)
apply(format, stream, format-string, format-args);
force-output(stream);
end;
end method test-output;

define constant $progress-none = #"progress-none";
define constant $progress-minimal = #"progress-minimal"; // Hide assertions unless they fail.
define constant $progress-all = #"progress-all"; // Display all assertions.
Expand Down Expand Up @@ -220,55 +159,62 @@ define method execute-component
let microseconds :: <integer> = 0;
let bytes :: <integer> = 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, <component-result>)
& 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, <component-result>)
& 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,
microseconds: microseconds,
bytes: bytes)
end method execute-component;

define function decide-suite-status
(subresults :: <sequence>) => (status :: <result-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 :: <runnable>, runner :: <test-runner>)
=> (result :: <component-result>)
Expand Down Expand Up @@ -309,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,
Expand All @@ -321,7 +267,7 @@ define method execute-component
bytes: bytes)
end method execute-component;

define function decide-status
define function decide-test-status
(test :: <runnable>, subresults, condition)
=> (status :: <result-status>, reason)
let benchmark? = ~test.test-requires-assertions?;
Expand Down Expand Up @@ -404,22 +350,24 @@ end method;
define method show-progress-done
(runner :: <test-runner>, component :: <component>, result :: <result>) => ()
let status = result.result-status;
let bytes = result.result-bytes;
test-output("%s%s %=%s%= %=%s%= in %ss%s\n",
test-output("%s%s %=%s%= %=%s%=",
*indent*,
capitalize(component.component-type-name),
$component-name-text-attributes,
component.component-name,
$reset-text-attributes,
result-status-to-text-attributes(status),
status.status-name.as-uppercase,
$reset-text-attributes,
result.result-time,
if (bytes)
format-to-string(" and %s", format-bytes(bytes))
else
""
end);
$reset-text-attributes);
let elapsed = result.result-time;
if (elapsed & status ~== $skipped & status ~== $not-implemented)
test-output(" in %ss", elapsed);
let bytes = result.result-bytes;
if (bytes)
test-output(" and %s", format-bytes(bytes));
end;
end;
test-output("\n");
end method;

// assertions
Expand Down
44 changes: 36 additions & 8 deletions tests/testworks-test-suite.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -420,14 +420,10 @@ define constant unexpected-success-suite

define test test-run-tests-expect-failure/suite ()
let runner = make(<test-runner>, 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;
Expand Down Expand Up @@ -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(<result>,
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.
Expand Down
Loading

0 comments on commit 349cfab

Please sign in to comment.