Skip to content

Commit

Permalink
Merge pull request #161 from cgay/got-want
Browse files Browse the repository at this point in the history 
Improve --progress and --report output
  • Loading branch information
@cgay
cgay authored Oct 13, 2023
2 parents 6c359d9 + 49e92c1 commit 5aa98e6
Show file tree
Hide file tree
Showing 18 changed files with 442 additions and 426 deletions.
115 changes: 69 additions & 46 deletions assertions.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,80 +43,102 @@ define macro check
end macro check;

define macro check-equal
{ check-equal (?name:expression, ?expr1:expression, ?expr2:expression)
{ check-equal (?name:expression, ?want:expression, ?got:expression)
} => {
do-check-equal(method () ?name end,
method ()
values(?expr1, ?expr2, ?"expr1", ?"expr2")
values(?want, ?got, ?"want", ?"got")
end,
negate?: #f,
"check-equal",
terminate?: #f)
}
end macro check-equal;

define macro assert-equal
{ assert-equal (?expr1:expression, ?expr2:expression)
{ assert-equal (?want:expression, ?got:expression)
} => {
assert-equal(?expr1, ?expr2, ?"expr1" " = " ?"expr2")
assert-equal(?want, ?got, ?"want" " = " ?"got")
}
{ assert-equal (?expr1:expression, ?expr2:expression, ?description:*)
{ assert-equal (?want:expression, ?got:expression, ?description:*)
} => {
do-check-equal(method () values(?description) end,
method ()
values(?expr1, ?expr2, ?"expr1", ?"expr2")
values(?want, ?got, ?"want", ?"got")
end,
negate?: #f,
"assert-equal",
terminate?: #t)
}
end macro assert-equal;

define function do-check-equal
(description-thunk :: <function>, arguments-thunk :: <function>,
caller :: <string>, #key terminate? :: <boolean>)
=> ()
let phase = "evaluating assertion description";
let description :: false-or(<string>) = #f;
block ()
description := eval-check-description(description-thunk);
phase := "evaluating assertion expressions";
let (want, got, want-expr, got-expr) = arguments-thunk();
phase := format-to-string("while comparing %s and %s for equality",
want-expr, got-expr);
if (want = got)
record-check(description, $passed, #f);
else
phase := format-to-string("getting %s failure detail", caller);
let detail = check-equal-failure-detail(want, got);
let detail = if (detail)
format-to-string("\n%s%sdetail: %s",
*indent*, $indent-step, detail)
else
""
end;
record-check(description, $failed,
format-to-string("want: %=\n%s%sgot: %=%s",
want, *indent*, $indent-step, got, detail));
terminate? & signal(make(<assertion-failure>));
end;
exception (err :: <serious-condition>, test: method (cond) ~debug?() end)
record-check(description | $invalid-description,
$crashed,
format-to-string("Error %s: %s", phase, err));
terminate? & signal(make(<assertion-failure>));
end block
end function;

define macro assert-not-equal
{ assert-not-equal (?expr1:expression, ?expr2:expression)
} => {
assert-not-equal(?expr1, ?expr2, ?"expr1" " ~= " ?"expr2")
}
{ assert-not-equal (?expr1:expression, ?expr2:expression, ?description:*)
} => {
do-check-equal(method () values(?description) end,
method ()
values(?expr1, ?expr2, ?"expr1", ?"expr2")
end,
negate?: #t,
terminate?: #t)
do-check-not-equal(method () values(?description) end,
method ()
values(?expr1, ?expr2, ?"expr1", ?"expr2")
end,
terminate?: #t)
}
end macro assert-not-equal;

define function do-check-equal
(description-thunk :: <function>, get-arguments :: <function>,
#key negate? :: <boolean>,
terminate? :: <boolean>)
define function do-check-not-equal
(description-thunk :: <function>, arguments-thunk :: <function>,
#key terminate? :: <boolean>)
=> ()
let phase = "evaluating assertion description";
let description :: false-or(<string>) = #f;
block ()
description := eval-check-description(description-thunk);
phase := "evaluating assertion expressions";
let (val1, val2, expr1, expr2) = get-arguments();
phase := format-to-string("while comparing %s and %s for %sequality",
expr1, expr2,
if (negate?) "in" else "" end);
let compare = if (negate?) \~= else \= end;
if (compare(val1, val2))
let (val1, val2, expr1, expr2) = arguments-thunk();
phase := format-to-string("while comparing %s and %s for inequality",
expr1, expr2);
if (val1 ~= val2)
record-check(description, $passed, #f);
else
phase := format-to-string("getting assert-%sequal failure detail",
if (negate?) "not-" else "" end);
let detail = if (negate?)
""
else
check-equal-failure-detail(val1, val2)
end;
phase := "getting assert-not-equal failure detail";
record-check(description, $failed,
format-to-string("%= and %= are %s=.%s%s",
val1, val2,
if (negate?) "" else "not " end,
if (detail) " " else "" end,
detail | ""));
format-to-string("%= and %= are =.", val1, val2));
terminate? & signal(make(<assertion-failure>));
end;
exception (err :: <serious-condition>, test: method (cond) ~debug?() end)
Expand All @@ -125,10 +147,11 @@ define function do-check-equal
format-to-string("Error %s: %s", phase, err));
terminate? & signal(make(<assertion-failure>));
end block
end function do-check-equal;
end function;

// Return a string with details about why two objects are not =.
// Users can override this for their own classes.
// Users can override this for their own classes. The output should
// be indented 4 spaces if you want it to display nicely.
define open generic check-equal-failure-detail
(val1 :: <object>, val2 :: <object>) => (detail :: false-or(<string>));

Expand All @@ -142,7 +165,7 @@ define method check-equal-failure-detail
if (coll1.size ~= coll2.size)
format-to-string("sizes differ (%d and %d)", coll1.size, coll2.size)
end
end method check-equal-failure-detail;
end method;

define method check-equal-failure-detail
(seq1 :: <sequence>, seq2 :: <sequence>) => (detail :: false-or(<string>))
Expand All @@ -151,14 +174,13 @@ define method check-equal-failure-detail
for (e1 in seq1, e2 in seq2, i from 0, while: e1 = e2)
finally
if (i < seq1.size & i < seq2.size)
// TODO(cgay): show the two element values.
detail2 := format-to-string("element %d is the first non-matching element", i);
detail2 := format-to-string("element %d is the first mismatch", i);
end;
end for;
join(choose(identity, vector(detail1, detail2)), ", ")
end method check-equal-failure-detail;
join(choose(identity, vector(detail1, detail2)), "; ")
end method;

// TODO: if key sets are same, compare values. Limit to showing 1 mismatch?
// TODO: limit the total number of keys/values output
define method check-equal-failure-detail
(t1 :: <table>, t2 :: <table>) => (detail :: false-or(<string>))
let detail1 = next-method();
Expand All @@ -174,12 +196,13 @@ define method check-equal-failure-detail
add!(t2-missing-keys, k);
end;
end;
let eformat = curry(format-to-string, "%="); // e for escape
let detail2 = (~empty?(t1-missing-keys)
& concatenate("table1 is missing keys ",
join(sort(t1-missing-keys), ", ")));
join(t1-missing-keys, ", ", key: eformat)));
let detail3 = (~empty?(t2-missing-keys)
& concatenate("table2 is missing keys ",
join(sort(t2-missing-keys), ", ")));
join(t2-missing-keys, ", ", key: eformat)));
join(choose(identity, vector(detail1, detail2, detail3)), "; ")
end method;

Expand Down
2 changes: 1 addition & 1 deletion benchmark.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ end;
define class <benchmark-result> (<component-result>)
end;

define class <benchmark-iteration-result> (<unit-result>, <metered-result>)
define class <benchmark-iteration-result> (<metered-result>)
end;

define method result-type-name
Expand Down
1 change: 0 additions & 1 deletion coloring.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ define constant $crashed-text-attributes = text-attributes(foreground
define constant $expected-to-fail-text-attributes = text-attributes(foreground: $color-cyan);
define constant $unexpected-success-text-attributes = text-attributes(foreground: $color-red);
define constant $component-name-text-attributes = text-attributes(intensity: $bright-intensity);
define constant $total-text-attributes = text-attributes(intensity: $bright-intensity);

define function result-status-to-text-attributes
(result :: <result-status>)
Expand Down
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%]"));
add-option(parser,
make(<repeated-parameter-option>,
names: "load",
Expand Down Expand Up @@ -105,7 +101,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 @@ -146,22 +142,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 @@ -217,7 +217,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
21 changes: 0 additions & 21 deletions components.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,9 +117,6 @@ end method;
define class <test> (<runnable>)
end;

define class <test-unit> (<test>)
end;


define generic component-type-name
(component :: <component>) => (type-name :: <string>);
Expand All @@ -129,11 +126,6 @@ define method component-type-name
"test"
end;

define method component-type-name
(test-unit :: <test-unit>) => (type-name :: <string>)
"test unit"
end;

define method component-type-name
(suite :: <suite>) => (type-name :: <string>)
"suite"
Expand Down Expand Up @@ -165,11 +157,6 @@ define method component-result-type
<suite-result>
end;

define method component-result-type
(component :: <test-unit>) => (result-type :: subclass(<result>))
<test-unit-result>
end;

// All tests, benchmarks, and suites are added to this when created.
define constant $components = make(<stretchy-vector>);

Expand Down Expand Up @@ -243,14 +230,6 @@ define macro benchmark-definer
}
end macro benchmark-definer;

// For backward compatibility.
define macro with-test-unit
{ with-test-unit (?name:expression, ?keyword-args:*)
?test-body:body
end
} => { ?test-body }
end macro with-test-unit;

// Find a minimal set of components that cover all tests and return
// them.
define function find-root-components () => (components :: <sequence>)
Expand Down
Loading

0 comments on commit 5aa98e6

Please sign in to comment.