Add DataLine plugin

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

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<warn ...> and C<die ...> 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: <DATA> line 5"
+
+=head1 SYNOPSIS
+
+    use Test2::Plugin::DataLine;
+
+=head1 SOURCE
+
+The source code repository for Test2-Suite can be found at
+F<https://github.com/Test-More/Test2-Suite/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>[email protected]<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>[email protected]<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2018 Chad Granum E<lt>[email protected]<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut

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(<DATA>, '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: <DATA> line 1'}}},
+        {info => bag {{tag => 'DIAG', debug => T(), details => 'Last filehandle read: <Foo::Bar::$fh> 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