diff --git a/Changes b/Changes index 79cb62ea..418e74ab 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,7 @@ {{$NEXT}} + - Add Test2::Plugin::DebugOnFail + 0.000153 2023-04-27 15:27:32-07:00 America/Los_Angeles - Fix broken call to plugins diff --git a/lib/Test2/Plugin/DataLine.pm b/lib/Test2/Plugin/DataLine.pm new file mode 100644 index 00000000..873408d3 --- /dev/null +++ b/lib/Test2/Plugin/DataLine.pm @@ -0,0 +1,117 @@ +package Test2::Plugin::DataLine; +use strict; +use warnings; + +use Test2::Event::V2; + +our $VERSION = '0.000154'; + +use B(); + +use Test2::API qw{ + test2_add_callback_post_load + test2_stack +}; + +sub import { + my $class = shift; + + test2_add_callback_post_load(sub { + my $hub = test2_stack()->top; + + $hub->pre_filter( + sub { + my ($hub, $event) = @_; + + if ($event->causes_fail) { + my $fd = $event->facet_data; + + if (my $line = $.) { + my $fh = eval '$${^LAST_FH}' || do { # Added in 5.18, the do is fallback + my $out; + local $SIG{__WARN__} = sub { + my $msg = shift; + $out = $msg; + }; + warn "blah"; + $out =~ m/<(.+)> line $line/ ? $1 : '?'; + }; + + $fh =~ s/^\*(main::)?//; + + my $msg = "Last filehandle read: <$fh> line $."; + + push @{$fd->{info} //= []} => { + details => $msg, + tag => 'DIAG', + debug => 1, + }; + + return Test2::Event::V2->new(%$fd); + } + } + + return $event; + }, + inherit => 1, + ); + }); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Plugin::DataLine - Add "<$fh> line X." diagnostics to failed tests. + +=head1 DESCRIPTION + +C and C will append "<$fh> line X." to warnings and +exceptions if C<$.> is true. This is the last filehandle read, and the line +number that was read. + +This plugin adds the same information to any failed tests. + +Example: "Last filehandle read: line 5" + +=head1 SYNOPSIS + + use Test2::Plugin::DataLine; + +=head1 SOURCE + +The source code repository for Test2-Suite can be found at +F. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum Eexodist@cpan.orgE. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F + +=cut diff --git a/t/modules/Plugin/DataLine.t b/t/modules/Plugin/DataLine.t new file mode 100644 index 00000000..741bf0e7 --- /dev/null +++ b/t/modules/Plugin/DataLine.t @@ -0,0 +1,42 @@ +use Test2::V0; +use Test2::API qw/intercept/; + +my $events = intercept { + require Test2::Plugin::DataLine; + Test2::Plugin::DataLine->import; + + package # + main; + + is(, 'nope', "Read data, not correct"); + ok(1, "pass"); + + package # + Foo::Bar; + + open(my $fh, '<', __FILE__) or die "Could not open: $!"; + main::is(<$fh>, 'nope', "Read data, not correct again"); + main::ok(1, "pass"); +}; + +my @failures = map { $_->facet_data } grep { $_->causes_fail } @$events; +my @other = map { $_->facet_data } grep { !$_->causes_fail } @$events; + +is(@failures, 2, "Got 2 failures"); + +like( + \@failures, + [ + {info => bag {{tag => 'DIAG', debug => T(), details => 'Last filehandle read: line 1'}}}, + {info => bag {{tag => 'DIAG', debug => T(), details => 'Last filehandle read: line 1'}}}, + ], + "Added the extra diagnostics to all failures", +); + +ok(!(grep { $_->{info} && $_->{info}->[-1]->{details} !~ m/Last filehandle read/ } @other), "Diags not added to any other events"); + +done_testing; + +__DATA__ +ooga booga +oga boga