Skip to content

Commit

Permalink
Cleanup: clarify the progress and debug options (with CLI change!)
Browse files Browse the repository at this point in the history 
This addresses an old TODO in the code and a related problem reflected in the
CLI.

```
Flag        Old options             New options
--progress  {none,default,verbose}  {none,minimal,all}
--debug     {none,crashes,failures} {none,crashes,all}
```

Note that previously `--debug failures` already had the effect of debugging
both crashes and failures, so `--debug all` is a more accurate name. (And I
think it unlikely anyone would need to debug failures but not crashes.)
  • Loading branch information
@cgay
cgay committed Oct 10, 2023
1 parent 9b7bb73 commit 669b0dc
Show file tree
Hide file tree
Showing 6 changed files with 97 additions and 73 deletions.
56 changes: 29 additions & 27 deletions command-line.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,11 +9,6 @@ Warranty: Distributed WITHOUT WARRANTY OF ANY KIND

define constant $list-option-values = #["all", "suites", "tests", "benchmarks"];

// types of progress to display
define constant $none = #"none";
define constant $default = #"default";
define constant $verbose = #"verbose";

// TODO(cgay): This seems to mix two concerns: what I want to output to the
// screen during and after the test run, and what I want stored in a file for
// later analysis. I think the --report option should apply to the latter and
Expand All @@ -34,30 +29,30 @@ define function parse-args
let parser = make(<command-line-parser>,
help: "Run tests.");
add-option(parser,
// TODO: When <choice-option> supports having an optional
// value then this can be made optional where no value
// means "failures".
make(<choice-option>,
names: "debug",
choices: #("no", "crashes", "failures"),
default: "no",
choices: #("none", "crashes", "all"),
default: "none",
variable: "WHAT",
help: "Enter the debugger on failure: NO|crashes|failures"));
help: "Enter the debugger? None, crashes, or all"
" (crashes and failures). [%default%]"));
add-option(parser,
make(<choice-option>,
names: #("progress", "p"),
choices: #("none", "default", "verbose"),
default: "default",
choices: #("none", "minimal", "all"),
default: "minimal",
variable: "TYPE",
help: "Show output as the test run progresses: none|DEFAULT|verbose"));
help: "Show test names and results as the test run progresses? None, minimal"
" (no assertions unless they fail), or all. [%default%]"));
add-option(parser,
make(<choice-option>,
names: "report",
choices: key-sequence($report-functions),
default: "failures",
variable: "TYPE",
help: format-to-string("Final report to generate: %s",
join(sort(key-sequence($report-functions)), "|"))));
help: format-to-string("Final report to generate: %s [%%default%%]",
join(sort(key-sequence($report-functions)), ", ",
conjunction: ", or "))));
add-option(parser,
make(<choice-option>,
names: "order",
Expand All @@ -68,7 +63,8 @@ define function parse-args
default: as-lowercase(as(<string>, $default-order)),
help: "Order in which to run tests. Note that when suites are being used"
" the suite is ordered with other tests/suites at the same level and"
" then when that suite runs its components are ordered separately."));
" then when that suite runs its components are ordered separately."
" [%default%]"));

// TODO(cgay): I adopted the convention of using ./_test in test-temp-directory()
// and we could use it here as the default location of the report file.
Expand Down Expand Up @@ -114,7 +110,7 @@ define function parse-args
default: #f,
variable: "WHAT",
help: format-to-string("List components: %s",
join($list-option-values, "|"))));
join($list-option-values, ", "))));
add-option(parser,
make(<repeated-parameter-option>,
names: #("tag", "t"),
Expand Down Expand Up @@ -155,22 +151,26 @@ define function make-runner-from-command-line
end);
(i & $components[i]) | usage-error("test component not found: %=", name);
end;
let debug = get-option-value(parser, "debug");
let debug = select (get-option-value(parser, "debug") by string-equal-ic?)
"none" => $debug-none;
"crashes" => $debug-crashes;
"all" => $debug-all;
end;
let progress = select (get-option-value(parser, "progress") by string-equal-ic?)
"none" => $progress-none;
"minimal" => $progress-minimal;
"all" => $progress-all;
end;
let report = get-option-value(parser, "report");
let progress = as(<symbol>, get-option-value(parser, "progress"));
let report-function = element($report-functions, report);
let runner = make(<test-runner>,
debug?: select (debug by \=)
"no" => #f;
"crashes" => #"crashes";
"failures" => #t;
end select,
debug: debug,
skip: concatenate(map(find-component,
get-option-value(parser, "skip-suite")),
map(find-component,
get-option-value(parser, "skip-test"))),
report: report,
progress: if (progress = $none) #f else progress end,
progress: progress,
tags: parse-tags(get-option-value(parser, "tag")),
order: as(<symbol>, get-option-value(parser, "order")),
options: get-option-value(parser, "options"));
Expand Down Expand Up @@ -226,7 +226,9 @@ define function run-test-application
exit-application(err.exit-status);
exception (error :: <error>,
test: method (cond)
test-runner & ~test-runner.debug-runner?
test-runner
& (runner-debug(test-runner) == $debug-crashes
| runner-debug(test-runner) == $debug-all)
end)
format(*standard-error*, "Error: %s", error);
exit-application(1);
Expand Down
16 changes: 12 additions & 4 deletions library.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,10 +34,11 @@ define module testworks
run-tests,
*runner*,
<test-runner>,
debug-runner?,
runner-debug,
runner-options,
runner-output-stream,
runner-progress,
runner-debug,
runner-skip,
runner-tags;

Expand Down Expand Up @@ -116,14 +117,18 @@ define module %testworks
import: { random };
use standard-io;
use streams;
use strings, import: { char-compare-ic, starts-with?, string-equal? };
use strings;
use testworks;
use threads,
import: { dynamic-bind };
use memory-manager, import: { collect-garbage };

// Debugging options
export
<debug-option>,
$debug-none,
$debug-crashes,
$debug-all,
debug-failures?,
debug?;

Expand Down Expand Up @@ -194,8 +199,11 @@ define module %testworks

// Progress
export
show-progress,
$default, $verbose;
$progress-none,
$progress-minimal,
$progress-all,
<progress-option>,
show-progress;

// Command line handling
export
Expand Down
63 changes: 35 additions & 28 deletions run.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,16 +55,6 @@ define function write-test-file
locator
end function;

define inline function debug-failures?
() => (debug-failures? :: <boolean>)
debug-runner?(*runner*) == #t
end;

define inline function debug?
() => (debug? :: <boolean>)
debug-runner?(*runner*) ~= #f
end;

// 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.
Expand All @@ -81,15 +71,32 @@ define method test-output
end;
end method test-output;

// These are terrible (e.g. what does #f or default mean here?). Use enums or something.
define constant <progress-option> = one-of(#f, $default, $verbose);
define constant <debug-option> = one-of(#f, #"crashes", #t);
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.
define constant <progress-option>
= one-of($progress-none, $progress-minimal, $progress-all);

define constant $debug-none = #"debug-none";
define constant $debug-crashes = #"debug-crashes";
define constant $debug-all = #"debug-all";
define constant <debug-option>
= one-of($debug-none, $debug-crashes, $debug-all);

define inline function debug-failures?
() => (debug-failures? :: <boolean>)
runner-debug(*runner*) == $debug-all
end function;

define inline function debug?
() => (debug? :: <boolean>)
runner-debug(*runner*) ~= $debug-none
end function;

define constant $source-order = #"source"; // order they appear in the source code.
define constant $lexical-order = #"lexical";
define constant $random-order = #"random";
define constant $default-order = $source-order;

define constant <order> = one-of($source-order, $lexical-order, $random-order);

define generic sort-components (components :: <sequence>, order :: <order>)
Expand All @@ -112,7 +119,7 @@ end;

define generic runner-tags (runner :: <test-runner>) => (tags :: <sequence>);
define generic runner-progress (runner :: <test-runner>) => (progress :: <progress-option>);
define generic debug-runner? (runner :: <test-runner>) => (debug? :: <debug-option>);
define generic runner-debug (runner :: <test-runner>) => (debug :: <debug-option>);
define generic runner-skip (runner :: <test-runner>) => (skip :: <sequence> /* of <component> */);
define generic runner-order (runner :: <test-runner>) => (order :: <order>);
define generic runner-output-stream (runner :: <test-runner>) => (stream :: <stream>);
Expand All @@ -126,10 +133,10 @@ define open class <test-runner> (<object>)
// init-keyword: report:;
constant slot runner-tags :: <sequence> = #[],
init-keyword: tags:;
constant slot runner-progress :: <progress-option>,
constant slot runner-progress :: <progress-option> = $progress-minimal,
init-keyword: progress:;
constant slot debug-runner? :: <debug-option> = #f,
init-keyword: debug?:;
constant slot runner-debug :: <debug-option> = $debug-none,
init-keyword: debug:;
constant slot runner-skip :: <sequence> = #[], // of components
init-keyword: skip:;
constant slot runner-order :: <order> = $default-order,
Expand Down Expand Up @@ -180,7 +187,7 @@ end;
define method maybe-execute-component
(component :: <component>, runner :: <test-runner>)
=> (result :: <component-result>)
if (runner.runner-progress)
if (runner.runner-progress ~== $progress-none)
show-progress(runner, component, #f);
end;
let result
Expand All @@ -199,7 +206,7 @@ define method maybe-execute-component
end;
force-output(*standard-error*);
force-output(*standard-output*);
if (runner.runner-progress)
if (runner.runner-progress ~== $progress-none)
show-progress(runner, component, result);
end;
result
Expand Down Expand Up @@ -269,7 +276,7 @@ define method execute-component
local
method record-check (result :: <result>)
add!(subresults, result);
if (*runner*.runner-progress)
if (*runner*.runner-progress == $progress-all)
show-progress(*runner*, #f, result);
end;
result
Expand Down Expand Up @@ -374,7 +381,7 @@ end method list-component;
// Show some output during the test run. For each component this is
// called both before and after it has been run. If before, result
// will be #f. This function is only called if runner.runner-progress
// ~= #f.
// is not $progress-none.
define generic show-progress
(runner :: <test-runner>,
component :: false-or(<component>),
Expand Down Expand Up @@ -414,7 +421,7 @@ end method show-progress;
define method show-progress
(runner :: <test-runner>, test :: <runnable>, result :: false-or(<result>))
=> ()
let verbose? = runner.runner-progress = $verbose;
let verbose? = runner.runner-progress == $progress-all;
if (result)
let reason = result.result-reason;
let result-status = result.result-status;
Expand All @@ -440,24 +447,24 @@ define method show-progress
end;
end method show-progress;

// Assertions are only displayed when they fail or the verbose option
// is set.
// `component == #f` means this is an assertion, only displayed when they fail
// or when --progress=all.
define method show-progress
(runner :: <test-runner>, component == #f, result :: <result>)
=> ()
let status = result.result-status;
let reason = result.result-reason;
if (runner.runner-progress = $verbose)
if (runner.runner-progress == $progress-all)
test-output(" %=%s%=: %s%s\n",
result-status-to-text-attributes(status),
status.status-name.as-uppercase,
$reset-text-attributes,
result.result-name,
reason & concatenate(" ", reason) | "");
elseif (reason)
elseif (reason & ~member?(status, $passing-statuses))
test-output("\n %s: %s", result.result-name, reason);
end;
end method show-progress;
end method;

define function test-option
(name :: <string>, #key default = unsupplied())
Expand Down
4 changes: 2 additions & 2 deletions tests/specification.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,10 @@ define interface-specification-suite testworks-interface-specification-suite ()
open generic function check-equal-failure-detail (<object>, <object>) => (false-or(<string>));

// For extending the runner capabilities.
function debug-runner? (<test-runner>) => (<object>);
function runner-debug (<test-runner>) => (<debug-option>);
function run-tests (<test-runner>, <component>) => (<component-result>);
function runner-output-stream (<test-runner>) => (<stream>);
function runner-progress (<test-runner>) => (one-of(#f, $default, $verbose));
function runner-progress (<test-runner>) => (<progress-option>);
function runner-skip (<test-runner>) => (<sequence>);
function runner-tags (<test-runner>) => (<sequence>);
function test-option (<string>, #"key", #"default") => (<string>);
Expand Down
8 changes: 4 additions & 4 deletions tests/test-command-line.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,10 +5,10 @@ Synopsis: Tests for command-line.dylan
define constant $dummy-suite = make(<suite>, name: "Dummy", components: #());

define test command-line-options-test ()
let args = list(list("--debug=no", debug-runner?, #f, #f),
list("--debug=crashes", debug-runner?, #"crashes", #f),
list("--debug=failures", debug-runner?, #t, #f),
list("--debug=foo", debug-runner?, #f, #t),
let args = list(list("--debug=none", runner-debug, $debug-none, #f),
list("--debug=crashes", runner-debug, $debug-crashes, #f),
list("--debug=all", runner-debug, $debug-all, #f),
list("--debug=foo", runner-debug, $debug-none, #t),
list("--options key1 = val1 --options key2 = val2", runner-options,
begin
let t = make(<string-table>);
Expand Down
Loading

0 comments on commit 669b0dc

Please sign in to comment.