Skip to content

Commit

Permalink
Make it possible to queue up diag for the context
Browse files Browse the repository at this point in the history
fixes #1004

This adds a system for queuing diag messages that will be attached to
the next context that releases, upon release the diags will be issued so
long as the context caused at least 1 failure. The diags will be
disgarded if the context did not add any failures.

the `no_warnings` and `lives` tools both now automatically add the
warning/exception to the diag queue.

Examples:

This will add the warning as a diagnostics message
ok(no_warnings { warn "xxx" }, "Did not get any warnings");

This will not add the warning-diag as no failures are caused
ok(!no_warnings { warn "xxx" }, "Got warnings");

This will add the exception as a diagnostics message
ok(lives { die "XXX" }, "Did not die");

This will not add the exception as a diagnostics message
ok(!lives { die "XXX" }, "Died");
  • Loading branch information
exodist committed Sep 14, 2024
1 parent b2b6510 commit 0f7b54e
Show file tree
Hide file tree
Showing 5 changed files with 71 additions and 16 deletions.
30 changes: 21 additions & 9 deletions lib/Test2/API.pm
Original file line number Diff line number Diff line change
Expand Up @@ -175,9 +175,19 @@ our @EXPORT_OK = qw{
test2_enable_trace_stamps
test2_disable_trace_stamps
test2_trace_stamps_enabled
test2_add_pending_diag
test2_get_pending_diags
test2_clear_pending_diags
};
BEGIN { require Exporter; our @ISA = qw(Exporter) }

my @PENDING_DIAGS;

sub test2_add_pending_diag { push @PENDING_DIAGS => @_ }
sub test2_get_pending_diags { @PENDING_DIAGS }
sub test2_clear_pending_diags { my @out = @PENDING_DIAGS; @PENDING_DIAGS = (); return @out }

my $STACK = $INST->stack;
my $CONTEXTS = $INST->contexts;
my $INIT_CBS = $INST->context_init_callbacks;
Expand Down Expand Up @@ -445,6 +455,7 @@ sub context {
eval_error => $eval_error,
child_error => $child_error,
_is_spawn => [$pkg, $file, $line, $sub],
_start_fail_count => $hub->{failed} // 0,
},
'Test2::API::Context'
) if $current && $depth_ok;
Expand Down Expand Up @@ -493,15 +504,16 @@ sub context {
my $aborted = 0;
$current = bless(
{
_aborted => \$aborted,
stack => $stack,
hub => $hub,
trace => $trace,
_is_canon => 1,
_depth => $depth,
errno => $errno,
eval_error => $eval_error,
child_error => $child_error,
_aborted => \$aborted,
stack => $stack,
hub => $hub,
trace => $trace,
_is_canon => 1,
_depth => $depth,
errno => $errno,
eval_error => $eval_error,
child_error => $child_error,
_start_fail_count => $hub->{failed} // 0,
$params{on_release} ? (_on_release => [$params{on_release}]) : (),
},
'Test2::API::Context'
Expand Down
20 changes: 19 additions & 1 deletion lib/Test2/API/Context.pm
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ my %LOADED = (
use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
use Test2::Util::HashBase qw{
stack hub trace _on_release _depth _is_canon _is_spawn _aborted
errno eval_error child_error thrown
errno eval_error child_error thrown _failed _start_fail_count
};

# Private, not package vars
Expand All @@ -42,6 +42,8 @@ sub init {
confess "The 'hub' attribute is required"
unless $self->{+HUB};

$self->{+_START_FAIL_COUNT} = $self->{+HUB}->{failed} // 0;

$self->{+_DEPTH} = 0 unless defined $self->{+_DEPTH};

$self->{+ERRNO} = $! unless exists $self->{+ERRNO};
Expand All @@ -64,6 +66,8 @@ sub DESTROY {
my $hub = $self->{+HUB};
my $hid = $hub->{hid};

$self->{+_FAILED} = ($hub->{failed} // 0) - $self->{+_START_FAIL_COUNT};

# Do not show the warning if it looks like an exception has been thrown, or
# if the context is not local to this process or thread.
{
Expand Down Expand Up @@ -111,6 +115,12 @@ Cleaning up the CONTEXT stack...
$_->($self) for reverse @$hcbk;
}
$_->($self) for reverse @$ON_RELEASE;

if (my @diags = Test2::API::test2_clear_pending_diags()) {
if ($self->{+_FAILED} || ${$self->{+_ABORTED}}) {
$self->diag($_) for @diags;
}
}
}

# release exists to implement behaviors like die-on-fail. In die-on-fail you
Expand All @@ -131,6 +141,8 @@ sub release {
my $hub = $self->{+HUB};
my $hid = $hub->{hid};

$self->{+_FAILED} = ($hub->{failed} // 0) - $self->{+_START_FAIL_COUNT};

croak "context thinks it is canon, but it is not"
unless $CONTEXTS->{$hid} && $CONTEXTS->{$hid} == $self;

Expand All @@ -146,6 +158,12 @@ sub release {
}
$_->($self) for reverse @$ON_RELEASE;

if (my @diags = Test2::API::test2_clear_pending_diags()) {
if ($self->{+_FAILED} || ${$self->{+_ABORTED}}) {
$self->diag($_) for @diags;
}
}

# Do this last so that nothing else changes them.
# If one of the hooks dies then these do not get restored, this is
# intentional
Expand Down
9 changes: 6 additions & 3 deletions lib/Test2/Tools/Exception.pm
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ use warnings;
our $VERSION = '1.302204';

use Carp qw/carp/;
use Test2::API qw/context/;
use Test2::API qw/context test2_add_pending_diag test2_clear_pending_diags/;

our @EXPORT = qw/dies lives try_ok/;
use base 'Exporter';
Expand Down Expand Up @@ -42,6 +42,8 @@ sub lives(&) {
$err = $@;
}

test2_add_pending_diag("Exception: $err");

# If the eval failed we want to set $@ to the error.
$@ = $err;
return 0;
Expand All @@ -53,12 +55,13 @@ sub try_ok(&;$) {
my $ok = &lives($code);
my $err = $@;

my @diag = test2_clear_pending_diags();

# Context should be obtained AFTER code is run so that events inside the
# codeblock report inside the codeblock itself. This will also preserve $@
# as thrown inside the codeblock.
my $ctx = context();
chomp(my $diag = "Exception: $err");
$ctx->ok($ok, $name, [$diag]);
$ctx->ok($ok, $name, \@diag);
$ctx->release;

$@ = $err unless $ok;
Expand Down
11 changes: 9 additions & 2 deletions lib/Test2/Tools/Warnings.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ use warnings;

our $VERSION = '1.302204';

use Test2::API qw/context/;
use Test2::API qw/context test2_add_pending_diag/;

our @EXPORT = qw/warns warning warnings no_warnings/;
use base 'Exporter';
Expand All @@ -17,7 +17,14 @@ sub warns(&) {
return $warnings;
}

sub no_warnings(&) { return !&warns(@_) }
sub no_warnings(&) {
my $warnings = &warnings(@_);
return 1 if !@$warnings;

test2_add_pending_diag(@$warnings);

return 0;
}

sub warning(&) {
my $code = shift;
Expand Down
17 changes: 16 additions & 1 deletion t/modules/Tools/Warnings.t
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,22 @@ is(warns { warn 'a' }, 1, "1 warning");
is(warns { warn 'a' for 1 .. 4 }, 4, "4 warnings");

ok(no_warnings { 0 }, "no warnings");
ok(!no_warnings { warn 'a' }, "warnings");

ok(!no_warnings { warn 'blah 1' }, "warnings");

my $es = intercept {
ok(!no_warnings { warn "blah 2\n" }, "warnings 1");
ok(no_warnings { warn "blah 3\n" }, "warnings 2")
};

like(
[grep { $_->isa('Test2::Event::Diag') } @$es],
[
{message => qr/Failed test 'warnings 2'/},
{message => "blah 3\n"},
],
"When the test failed we got a diag about the warning, but we got no diag when it passed"
);

is(
warnings { 0 },
Expand Down

0 comments on commit 0f7b54e

Please sign in to comment.