Skip to content

Improve exception handling (for --debug option) #204

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
cgay merged 2 commits into from
Sep 16, 2025
+202 −137
Merged

Improve exception handling (for --debug option) #204

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
f2ffc72
Improve exception handling (for --debug option)
cgay Sep 13, 2025
58ceb7d
Improve error messages generated when --debug option is used
cgay Sep 14, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
132 changes: 72 additions & 60 deletions assertions.dylan
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,20 @@ Warranty: Distributed WITHOUT WARRANTY OF ANY KIND

define constant $invalid-description = "*** invalid description ***";

// This is used to do a non-local exit to the end of a test and skip remaining assertions.
define class <assertion-failure> (<condition>) end;
// This is used to do a non-local exit to the end of a test and skip remaining
// assertions. It's a subclass of <serious-condition> so that the debugger will be
// invoked if we don't handle it, e.g., for '--debug failures'.
define class <assertion-failure> (<error>)
constant slot %reason :: <string>, required-init-keyword: reason:;
end class;

define method condition-to-string (c :: <assertion-failure>) => (s :: <string>)
c.%reason
end method;

define function assertion-failure (reason :: <string>)
signal(make(<assertion-failure>, reason: reason))
end function;

/// Assertion macros

Expand Down Expand Up @@ -100,6 +112,10 @@ define macro expect-equal
terminate?: #f) }
end macro;

define function handle-assertion-condition? (c :: <condition>)
~instance?(c, <assertion-failure>) & handle-condition?(*runner*, c)
end function;

define function do-check-equal
(description-thunk :: <function>, arguments-thunk :: <function>, caller :: <string>,
#key terminate? :: <boolean>)
Expand All @@ -123,16 +139,15 @@ define function do-check-equal
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>));
let reason = format-to-string("want: %=\n%s%sgot: %=%s",
want, *indent*, $indent-step, got, detail);
record-check(description, $failed, reason);
terminate? & assertion-failure(concatenate(caller, ": ", reason));
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>));
exception (err :: <serious-condition>, test: handle-assertion-condition?)
let reason = format-to-string("Error %s: %s", phase, err);
record-check(description | $invalid-description, $crashed, reason);
terminate? & assertion-failure(reason);
end block
end function;

Expand Down Expand Up @@ -179,15 +194,14 @@ define function do-check-not-equal
record-check(description, $passed, #f);
else
phase := format-to-string("getting %s failure detail", caller);
record-check(description, $failed,
format-to-string("%= and %= are =.", val1, val2));
terminate? & signal(make(<assertion-failure>));
let reason = format-to-string("%= and %= are =.", val1, val2);
record-check(description, $failed, reason);
terminate? & assertion-failure(concatenate(caller, ": ", reason));
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>));
exception (err :: <serious-condition>, test: handle-assertion-condition?)
let reason = format-to-string("Error %s: %s", phase, err);
record-check(description | $invalid-description, $crashed, reason);
terminate? & assertion-failure(reason);
end block
end function;

Expand Down Expand Up @@ -324,21 +338,20 @@ define function do-check-instance?
description := eval-check-description(description-thunk);
phase := format-to-string("evaluating %s expressions", caller);
let (type :: <type>, value, value-expr :: <string>) = get-arguments();
phase := format-to-string("checking if expression %s is %=an instance of %s",
phase := format-to-string("checking if expression %s is %san instance of %s",
value-expr, if (negate?) "not " else "" end, type);
if (instance?(value, type) ~= negate?)
record-check(description, $passed, #f);
else
record-check(description, $failed,
format-to-string("%=, from expression %s, is not an instance of %s.",
value, value-expr, type));
terminate? & signal(make(<assertion-failure>));
let reason = format-to-string("%=, from expression %s, is not an instance of %s.",
value, value-expr, type);
record-check(description, $failed, reason);
terminate? & assertion-failure(concatenate(caller, ": ", reason));
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>));
exception (err :: <serious-condition>, test: handle-assertion-condition?)
let reason = format-to-string("Error %s: %s", phase, err);
record-check(description | $invalid-description, $crashed, reason);
terminate? & assertion-failure(reason);
end block
end function do-check-instance?;

Expand Down Expand Up @@ -377,15 +390,14 @@ define function do-check-true
if (value)
record-check(description, $passed, #f);
else
record-check(description, $failed,
format-to-string("expression %s is false.", value-expr));
terminate? & signal(make(<assertion-failure>));
let reason = format-to-string("expression %s is false.", value-expr);
record-check(description, $failed, reason);
terminate? & assertion-failure(concatenate(caller, ": ", reason));
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>));
exception (err :: <serious-condition>, test: handle-assertion-condition?)
let reason = format-to-string("Error %s: %s", phase, err);
record-check(description | $invalid-description, $crashed, reason);
terminate? & assertion-failure(reason);
end block
end function do-check-true;

Expand Down Expand Up @@ -438,16 +450,15 @@ define function do-check-false
if (~value)
record-check(description, $passed, #f);
else
record-check(description, $failed,
format-to-string("expression %s evaluates to %=; expected #f.",
value-expr, value));
terminate? & signal(make(<assertion-failure>));
let reason = format-to-string("expression %s evaluates to %=; expected #f.",
value-expr, value);
record-check(description, $failed, reason);
terminate? & assertion-failure(concatenate(caller, ": ", reason));
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>));
exception (err :: <serious-condition>, test: handle-assertion-condition?)
let reason = format-to-string("Error %s: %s", phase, err);
record-check(description | $invalid-description, $crashed, reason);
terminate? & assertion-failure(reason);
end block
end function do-check-false;

Expand Down Expand Up @@ -511,25 +522,26 @@ define function do-check-condition
expr, condition-class);
block ()
thunk();
record-check(description, $failed, "no condition signaled");
terminate? & signal(make(<assertion-failure>));
let reason = "no condition signaled";
record-check(description, $failed, reason);
terminate? & assertion-failure(concatenate(caller, ": ", reason));
exception (ex :: condition-class)
record-check(description, $passed, #f);
// Not really sure if this should catch something broader, like
// <condition>, but leaving it this way for compat with old code.
exception (ex :: <serious-condition>)
record-check(description, $failed,
format-to-string("condition of class %s signaled; "
exception (ex :: <condition>,
test: method (c)
~instance?(c, <assertion-failure>)
end)
let reason = format-to-string("condition of class %s signaled; "
"expected a condition of class %s. "
"The error was: %s",
ex.object-class, condition-class, ex));
terminate? & signal(make(<assertion-failure>));
ex.object-class, condition-class, ex);
record-check(description, $failed, reason);
terminate? & assertion-failure(concatenate(caller, ": ", reason));
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>));
exception (err :: <serious-condition>, test: handle-assertion-condition?)
let reason = format-to-string("Error %s: %s", phase, err);
record-check(description | $invalid-description, $crashed, reason);
terminate? & assertion-failure(reason);
end block
end function do-check-condition;

Expand Down
13 changes: 7 additions & 6 deletions command-line.dylan
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,11 +31,11 @@ define function parse-args
add-option(parser,
make(<choice-option>,
names: "debug",
choices: #("none", "crashes", "all"),
choices: #("none", "crashes", "failures", "all"),
default: "none",
variable: "WHAT",
help: "Enter the debugger? None, crashes, or all"
" (crashes and failures). [%default%]"));
help: "Enter the debugger? none, crashes, failures, or all."
" [%default%]"));
add-option(parser,
make(<choice-option>,
names: #("progress", "p"),
Expand Down Expand Up @@ -132,9 +132,10 @@ define function make-runner-from-command-line
get-option-value(parser, "run"),
get-option-value(parser, "skip"));
let debug = select (as-lowercase(get-option-value(parser, "debug")) by \=)
"none" => $debug-none;
"crashes" => $debug-crashes;
"all" => $debug-all;
"none" => $debug-none;
"crashes" => $debug-crashes;
"failures" => $debug-failures;
"all" => $debug-all;
end;
let progress = select (as-lowercase(get-option-value(parser, "progress")) by \=)
"none" => $progress-none;
Expand Down
11 changes: 7 additions & 4 deletions library.dylan
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -139,9 +139,8 @@ define module %testworks
<debug-option>,
$debug-none,
$debug-crashes,
$debug-all,
debug-failures?,
debug?;
$debug-failures,
$debug-all;

// Components
export
Expand Down Expand Up @@ -238,6 +237,10 @@ define module %testworks

// Specs accessors
export spec-name,
spec-title;
spec-title;

// Conditions
export
<assertion-failure>;

end module %testworks;
46 changes: 31 additions & 15 deletions run.dylan
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,20 +17,11 @@ define constant <progress-option>
= one-of($progress-none, $progress-minimal, $progress-all);

define constant $debug-none = #"debug-none";
define constant $debug-failures = #"debug-failures";
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;
= one-of($debug-none, $debug-crashes, $debug-failures, $debug-all);

define constant $source-order = #"source"; // order they appear in the source code.
define constant $lexical-order = #"lexical";
Expand Down Expand Up @@ -167,7 +158,8 @@ define method execute-component
skip-result := $skipped;
skip-reason := reason | format-to-string("disabled by when: option");
end
exception (err :: <serious-condition>, test: method (c) ~debug?() end)
exception (err :: <serious-condition>,
test: curry(handle-condition?, runner))
skip-result := $crashed;
skip-reason := format-to-string("Error in %s for suite %s: %s",
context, suite.component-name, err);
Expand Down Expand Up @@ -267,16 +259,16 @@ define method execute-component
block ()
test.test-function();
exception (err :: <assertion-failure>,
test: method (c) ~debug?() end)
test: curry(handle-condition?, runner))
// An assertion failure causes the remainder of a test to be
// skipped (by jumping here) to prevent cascading failures.
// The failure has already been recorded so nothing to do.
#f
exception (err :: <serious-condition>,
test: method (c) ~debug?() end)
test: curry(handle-condition?, runner))
err
end;
results
results
seconds := cpu-time-seconds;
microseconds := cpu-time-microseconds;
bytes := allocation;
Expand All @@ -294,6 +286,30 @@ define method execute-component
end if
end method execute-component;

define generic handle-condition?
(runner :: <test-runner>, cond :: <condition>) => (b :: <boolean>);

define method handle-condition?
(runner :: <test-runner>, cond :: <condition>) => (b :: <boolean>)
#f
end method;

define method handle-condition?
(runner :: <test-runner>, cond :: <assertion-failure>) => (b :: <boolean>)
select (runner.runner-debug)
$debug-failures, $debug-all => #f;
otherwise => #t;
end
end method;

define method handle-condition?
(runner :: <test-runner>, cond :: <serious-condition>) => (b :: <boolean>)
select (runner.runner-debug)
$debug-crashes, $debug-all => #f;
otherwise => #t;
end
end method;

define function make-skip-result (component, reason)
make(component-result-type(component),
name: component.component-name,
Expand Down
Loading
Loading