This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Test-Simple to CPAN version 1.302181
authorTodd Rinaldo <toddr@cpan.org>
Wed, 16 Sep 2020 02:23:31 +0000 (21:23 -0500)
committerTodd Rinaldo <toddr@cpan.org>
Wed, 16 Sep 2020 04:42:34 +0000 (23:42 -0500)
[DELTA]

1.302181  2020-09-14 09:46:04-07:00 America/Los_Angeles

    - put try_sig_mask back where it goes (And add test to prevent this in the future)
    - Drop new List::Util requirement back down

1.302180  2020-09-13 23:11:18-07:00 America/Los_Angeles

    - No changes since last trial

1.302179  2020-09-12 22:35:19-07:00 America/Los_Angeles (TRIAL RELEASE)

    - Bump minimum List::Util version (for uniq)

1.302178  2020-09-07 14:11:52-07:00 America/Los_Angeles (TRIAL RELEASE)

    - Move try_sig_mask to the only module that uses it.
    - Inherit warnings bitmask in cmp_ok string eval
    - Update copyright date
    - Improved API for interept {} and what it returns

1.302177  2020-08-06 21:46:06-07:00 America/Los_Angeles

    - Minor fix to author downstream test
    - No significant changes since the last trial

1.302176  2020-08-05 21:45:19-07:00 America/Los_Angeles (TRIAL RELEASE)

    - Fix Test::More's $TODO inside intercept (#862)

85 files changed:
MANIFEST
Makefile.SH
Porting/Maintainers.pl
cpan/Test-Simple/lib/Test/Builder.pm
cpan/Test-Simple/lib/Test/Builder/Formatter.pm
cpan/Test-Simple/lib/Test/Builder/Module.pm
cpan/Test-Simple/lib/Test/Builder/Tester.pm
cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm
cpan/Test-Simple/lib/Test/More.pm
cpan/Test-Simple/lib/Test/Simple.pm
cpan/Test-Simple/lib/Test/Tester.pm
cpan/Test-Simple/lib/Test/Tester/Capture.pm
cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm
cpan/Test-Simple/lib/Test/Tester/Delegate.pm
cpan/Test-Simple/lib/Test/use/ok.pm
cpan/Test-Simple/lib/Test2.pm
cpan/Test-Simple/lib/Test2/API.pm
cpan/Test-Simple/lib/Test2/API/Breakage.pm
cpan/Test-Simple/lib/Test2/API/Context.pm
cpan/Test-Simple/lib/Test2/API/Instance.pm
cpan/Test-Simple/lib/Test2/API/InterceptResult.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm [new file with mode: 0644]
cpan/Test-Simple/lib/Test2/API/Stack.pm
cpan/Test-Simple/lib/Test2/Event.pm
cpan/Test-Simple/lib/Test2/Event/Bail.pm
cpan/Test-Simple/lib/Test2/Event/Diag.pm
cpan/Test-Simple/lib/Test2/Event/Encoding.pm
cpan/Test-Simple/lib/Test2/Event/Exception.pm
cpan/Test-Simple/lib/Test2/Event/Fail.pm
cpan/Test-Simple/lib/Test2/Event/Generic.pm
cpan/Test-Simple/lib/Test2/Event/Note.pm
cpan/Test-Simple/lib/Test2/Event/Ok.pm
cpan/Test-Simple/lib/Test2/Event/Pass.pm
cpan/Test-Simple/lib/Test2/Event/Plan.pm
cpan/Test-Simple/lib/Test2/Event/Skip.pm
cpan/Test-Simple/lib/Test2/Event/Subtest.pm
cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm
cpan/Test-Simple/lib/Test2/Event/V2.pm
cpan/Test-Simple/lib/Test2/Event/Waiting.pm
cpan/Test-Simple/lib/Test2/EventFacet.pm
cpan/Test-Simple/lib/Test2/EventFacet/About.pm
cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm
cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm
cpan/Test-Simple/lib/Test2/EventFacet/Control.pm
cpan/Test-Simple/lib/Test2/EventFacet/Error.pm
cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm
cpan/Test-Simple/lib/Test2/EventFacet/Info.pm
cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm
cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm
cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm
cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm
cpan/Test-Simple/lib/Test2/EventFacet/Render.pm
cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm
cpan/Test-Simple/lib/Test2/Formatter.pm
cpan/Test-Simple/lib/Test2/Formatter/TAP.pm
cpan/Test-Simple/lib/Test2/Hub.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm
cpan/Test-Simple/lib/Test2/Hub/Subtest.pm
cpan/Test-Simple/lib/Test2/IPC.pm
cpan/Test-Simple/lib/Test2/IPC/Driver.pm
cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm
cpan/Test-Simple/lib/Test2/Tools/Tiny.pm
cpan/Test-Simple/lib/Test2/Transition.pod
cpan/Test-Simple/lib/Test2/Util.pm
cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm
cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm
cpan/Test-Simple/lib/Test2/Util/HashBase.pm
cpan/Test-Simple/lib/Test2/Util/Trace.pm
cpan/Test-Simple/lib/ok.pm
cpan/Test-Simple/t/Legacy/Builder/current_test.t
cpan/Test-Simple/t/Legacy/Regression/870-experimental-warnings.t [new file with mode: 0644]
cpan/Test-Simple/t/Legacy/buffer.t
cpan/Test-Simple/t/Legacy/fail-like.t
cpan/Test-Simple/t/Legacy/is_deeply_fail.t
cpan/Test-Simple/t/Legacy/todo.t
cpan/Test-Simple/t/Test2/modules/API/InterceptResult.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Event.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Squasher.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/Event/V2.t
cpan/Test-Simple/t/regression/862-intercept_tb_todo.t [new file with mode: 0644]

index e8161a9..5ab5aca 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2255,6 +2255,11 @@ cpan/Test-Simple/lib/Test2/API.pm
 cpan/Test-Simple/lib/Test2/API/Breakage.pm
 cpan/Test-Simple/lib/Test2/API/Context.pm
 cpan/Test-Simple/lib/Test2/API/Instance.pm
+cpan/Test-Simple/lib/Test2/API/InterceptResult.pm
+cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm
+cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm
+cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm
+cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm
 cpan/Test-Simple/lib/Test2/API/Stack.pm
 cpan/Test-Simple/lib/Test2/Event.pm
 cpan/Test-Simple/lib/Test2/Event/Bail.pm
@@ -2387,6 +2392,7 @@ cpan/Test-Simple/t/Legacy/Regression/683_thread_todo.t
 cpan/Test-Simple/t/Legacy/Regression/6_cmp_ok.t
 cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t
 cpan/Test-Simple/t/Legacy/Regression/789-read-only.t
+cpan/Test-Simple/t/Legacy/Regression/870-experimental-warnings.t
 cpan/Test-Simple/t/Legacy/require_ok.t
 cpan/Test-Simple/t/Legacy/run_test.t
 cpan/Test-Simple/t/Legacy/simple.t
@@ -2472,6 +2478,7 @@ cpan/Test-Simple/t/regression/721-nested-streamed-subtest.t
 cpan/Test-Simple/t/regression/757-reset_in_subtest.t
 cpan/Test-Simple/t/regression/812-todo.t
 cpan/Test-Simple/t/regression/817-subtest-todo.t
+cpan/Test-Simple/t/regression/862-intercept_tb_todo.t
 cpan/Test-Simple/t/regression/buffered_subtest_plan_buffered.t
 cpan/Test-Simple/t/regression/builder_does_not_init.t
 cpan/Test-Simple/t/regression/errors_facet.t
@@ -2513,6 +2520,9 @@ cpan/Test-Simple/t/Test2/modules/API.t
 cpan/Test-Simple/t/Test2/modules/API/Breakage.t
 cpan/Test-Simple/t/Test2/modules/API/Context.t
 cpan/Test-Simple/t/Test2/modules/API/Instance.t
+cpan/Test-Simple/t/Test2/modules/API/InterceptResult.t
+cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Event.t
+cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Squasher.t
 cpan/Test-Simple/t/Test2/modules/API/Stack.t
 cpan/Test-Simple/t/Test2/modules/Event.t
 cpan/Test-Simple/t/Test2/modules/Event/Bail.t
index a65c348..fa8d9e3 100755 (executable)
@@ -1439,28 +1439,28 @@ _cleaner2:
        -rmdir lib/Test2/IPC/Driver lib/Test2/IPC lib/Test2/Hub/Interceptor
        -rmdir lib/Test2/Hub lib/Test2/Formatter lib/Test2/EventFacet/Info
        -rmdir lib/Test2/EventFacet lib/Test2/Event/TAP lib/Test2/Event
-       -rmdir lib/Test2/API lib/Test2 lib/Test/use lib/Test/Tester
-       -rmdir lib/Test/Builder/Tester lib/Test/Builder/IO lib/Test/Builder
-       -rmdir lib/Test lib/Term lib/TAP/Parser/YAMLish
-       -rmdir lib/TAP/Parser/SourceHandler lib/TAP/Parser/Scheduler
-       -rmdir lib/TAP/Parser/Result lib/TAP/Parser/Iterator lib/TAP/Parser
-       -rmdir lib/TAP/Harness lib/TAP/Formatter/File
-       -rmdir lib/TAP/Formatter/Console lib/TAP/Formatter lib/TAP
-       -rmdir lib/Sys/Syslog lib/Sys lib/Sub lib/Search lib/Scalar
-       -rmdir lib/Pod/Text lib/Pod/Simple lib/Pod/Perldoc lib/PerlIO/via
-       -rmdir lib/PerlIO lib/Perl lib/Parse/CPAN lib/Parse lib/Params
-       -rmdir lib/Net/FTP lib/Module/Load lib/Module/CoreList lib/Module
-       -rmdir lib/Memoize lib/Math/BigInt lib/Math/BigFloat lib/Math lib/MIME
-       -rmdir lib/Locale/Maketext lib/Locale lib/List/Util lib/List
-       -rmdir lib/JSON/PP lib/JSON lib/IPC lib/IO/Uncompress/Adapter
-       -rmdir lib/IO/Uncompress lib/IO/Socket lib/IO/Compress/Zlib
-       -rmdir lib/IO/Compress/Zip lib/IO/Compress/Gzip lib/IO/Compress/Base
-       -rmdir lib/IO/Compress/Adapter lib/IO/Compress lib/IO
-       -rmdir lib/I18N/LangTags lib/I18N lib/Hash/Util lib/Hash lib/HTTP
-       -rmdir lib/Filter/Util lib/Filter lib/File/Spec lib/ExtUtils/Typemaps
-       -rmdir lib/ExtUtils/ParseXS lib/ExtUtils/MakeMaker/version
-       -rmdir lib/ExtUtils/MakeMaker lib/ExtUtils/Liblist
-       -rmdir lib/ExtUtils/Constant lib/ExtUtils/Command
+       -rmdir lib/Test2/API/InterceptResult lib/Test2/API lib/Test2
+       -rmdir lib/Test/use lib/Test/Tester lib/Test/Builder/Tester
+       -rmdir lib/Test/Builder/IO lib/Test/Builder lib/Test lib/Term
+       -rmdir lib/TAP/Parser/YAMLish lib/TAP/Parser/SourceHandler
+       -rmdir lib/TAP/Parser/Scheduler lib/TAP/Parser/Result
+       -rmdir lib/TAP/Parser/Iterator lib/TAP/Parser lib/TAP/Harness
+       -rmdir lib/TAP/Formatter/File lib/TAP/Formatter/Console
+       -rmdir lib/TAP/Formatter lib/TAP lib/Sys/Syslog lib/Sys lib/Sub
+       -rmdir lib/Search lib/Scalar lib/Pod/Text lib/Pod/Simple
+       -rmdir lib/Pod/Perldoc lib/PerlIO/via lib/PerlIO lib/Perl
+       -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/Net/FTP lib/Module/Load
+       -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigInt
+       -rmdir lib/Math/BigFloat lib/Math lib/MIME lib/Locale/Maketext
+       -rmdir lib/Locale lib/List/Util lib/List lib/JSON/PP lib/JSON lib/IPC
+       -rmdir lib/IO/Uncompress/Adapter lib/IO/Uncompress lib/IO/Socket
+       -rmdir lib/IO/Compress/Zlib lib/IO/Compress/Zip lib/IO/Compress/Gzip
+       -rmdir lib/IO/Compress/Base lib/IO/Compress/Adapter lib/IO/Compress
+       -rmdir lib/IO lib/I18N/LangTags lib/I18N lib/Hash/Util lib/Hash
+       -rmdir lib/HTTP lib/Filter/Util lib/Filter lib/File/Spec
+       -rmdir lib/ExtUtils/Typemaps lib/ExtUtils/ParseXS
+       -rmdir lib/ExtUtils/MakeMaker/version lib/ExtUtils/MakeMaker
+       -rmdir lib/ExtUtils/Liblist lib/ExtUtils/Constant lib/ExtUtils/Command
        -rmdir lib/ExtUtils/CBuilder/Platform/Windows
        -rmdir lib/ExtUtils/CBuilder/Platform lib/ExtUtils/CBuilder
        -rmdir lib/Exporter lib/Encode/Unicode lib/Encode/MIME/Header
index 7a41a46..fc46607 100755 (executable)
@@ -1078,7 +1078,7 @@ use File::Glob qw(:case);
     },
 
     'Test::Simple' => {
-        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302175.tar.gz',
+        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302181.tar.gz',
         'FILES'        => q[cpan/Test-Simple],
         'EXCLUDED'     => [
             qr{^examples/},
index 1a49b7a..b719598 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN {
     if( $] < 5.008 ) {
@@ -51,40 +51,80 @@ sub _add_ts_hooks {
 
     #$hub->add_context_aquire(sub {$_[0]->{level} += $Level - 1});
 
-    $hub->pre_filter(sub {
-        my ($active_hub, $e) = @_;
+    $hub->pre_filter(
+        sub {
+            my ($active_hub, $e) = @_;
 
-        my $epkg = $$epkgr;
-        my $cpkg = $e->{trace} ? $e->{trace}->{frame}->[0] : undef;
+            my $epkg = $$epkgr;
+            my $cpkg = $e->{trace} ? $e->{trace}->{frame}->[0] : undef;
 
-        no strict 'refs';
-        no warnings 'once';
-        my $todo;
-        $todo = ${"$cpkg\::TODO"} if $cpkg;
-        $todo = ${"$epkg\::TODO"} if $epkg && !$todo;
+            no strict 'refs';
+            no warnings 'once';
+            my $todo;
+            $todo = ${"$cpkg\::TODO"} if $cpkg;
+            $todo = ${"$epkg\::TODO"} if $epkg && !$todo;
 
-        return $e unless defined($todo);
-        return $e unless length($todo);
+            return $e unless defined($todo);
+            return $e unless length($todo);
 
-        # Turn a diag into a todo diag
-        return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag';
+            # Turn a diag into a todo diag
+            return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag';
 
-        $e->set_todo($todo) if $e->can('set_todo');
-        $e->add_amnesty({tag => 'TODO', details => $todo});
+            $e->set_todo($todo) if $e->can('set_todo');
+            $e->add_amnesty({tag => 'TODO', details => $todo});
 
-        # Set todo on ok's
-        if ($e->isa('Test2::Event::Ok')) {
-            $e->set_effective_pass(1);
+            # Set todo on ok's
+            if ($e->isa('Test2::Event::Ok')) {
+                $e->set_effective_pass(1);
 
-            if (my $result = $e->get_meta(__PACKAGE__)) {
-                $result->{reason} ||= $todo;
-                $result->{type}   ||= 'todo';
-                $result->{ok}       = 1;
+                if (my $result = $e->get_meta(__PACKAGE__)) {
+                    $result->{reason} ||= $todo;
+                    $result->{type}   ||= 'todo';
+                    $result->{ok} = 1;
+                }
             }
-        }
 
-        return $e;
-    }, inherit => 1);
+            return $e;
+        },
+
+        inherit => 1,
+
+        intercept_inherit => {
+            clean => sub {
+                my %params = @_;
+
+                my $state = $params{state};
+                my $trace = $params{trace};
+
+                my $epkg = $$epkgr;
+                my $cpkg = $trace->{frame}->[0];
+
+                no strict 'refs';
+                no warnings 'once';
+
+                $state->{+__PACKAGE__} = {};
+                $state->{+__PACKAGE__}->{"$cpkg\::TODO"} = ${"$cpkg\::TODO"} if $cpkg;
+                $state->{+__PACKAGE__}->{"$epkg\::TODO"} = ${"$epkg\::TODO"} if $epkg;
+
+                ${"$cpkg\::TODO"} = undef if $cpkg;
+                ${"$epkg\::TODO"} = undef if $epkg;
+            },
+            restore => sub {
+                my %params = @_;
+                my $state = $params{state};
+
+                no strict 'refs';
+                no warnings 'once';
+
+                for my $item (keys %{$state->{+__PACKAGE__}}) {
+                    no strict 'refs';
+                    no warnings 'once';
+
+                    ${"$item"} = $state->{+__PACKAGE__}->{$item};
+                }
+            },
+        },
+    );
 }
 
 {
@@ -922,9 +962,11 @@ sub cmp_ok {
         local( $@, $!, $SIG{__DIE__} );    # isolate eval
 
         my($pack, $file, $line) = $ctx->trace->call();
+        my $warning_bits = $ctx->trace->warning_bits;
 
         # This is so that warnings come out at the caller's level
         $succ = eval qq[
+BEGIN {\${^WARNING_BITS} = \$warning_bits};
 #line $line "(eval in cmp_ok) $file"
 \$test = (\$got $type \$expect);
 1;
index ab405ca..12a5d03 100644 (file)
@@ -2,7 +2,7 @@ package Test::Builder::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) }
 
@@ -97,7 +97,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 6e550eb..882a93d 100644 (file)
@@ -7,7 +7,7 @@ use Test::Builder;
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 =head1 NAME
index da98e3d..d34cf48 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Test::Builder;
 use Symbol;
index 116e605..c58c1f3 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester::Color;
 
 use strict;
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 require Test::Builder::Tester;
 
index b69ca25..4b36edd 100644 (file)
@@ -2,7 +2,7 @@ package Test::Builder::TodoDiag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) }
 
@@ -58,7 +58,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index b2f8228..9487e98 100644 (file)
@@ -17,7 +17,7 @@ sub _carp {
     return warn @_, " at $file line $line\n";
 }
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index 6ff8183..c5d922b 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 
 use strict;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index 1cc7bd1..cfeddf3 100644 (file)
@@ -18,7 +18,7 @@ require Exporter;
 
 use vars qw( @ISA @EXPORT );
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 @EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
 @ISA = qw( Exporter );
index c5c4542..d49a6c9 100644 (file)
@@ -2,7 +2,7 @@ use strict;
 
 package Test::Tester::Capture;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Test::Builder;
index a86ef06..7e941f0 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 
 package Test::Tester::CaptureRunner;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Test::Tester::Capture;
index 2036f2e..f90d84c 100644 (file)
@@ -3,7 +3,7 @@ use warnings;
 
 package Test::Tester::Delegate;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Scalar::Util();
 
index 4113ef5..0415440 100644 (file)
@@ -1,7 +1,7 @@
 package Test::use::ok;
 use 5.005;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 __END__
index d915631..6afd64c 100644 (file)
@@ -2,7 +2,7 @@ package Test2;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 1;
@@ -203,7 +203,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 6c51741..f0ddca8 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
     $ENV{TEST2_ACTIVE} = 1;
 }
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 my $INST;
@@ -404,10 +404,10 @@ sub context {
     my $end_phase = $ENDING || $phase eq 'END' || $phase eq 'DESTRUCT';
 
     my $level = 1 + $params{level};
-    my ($pkg, $file, $line, $sub) = $end_phase ? caller(0) : caller($level);
+    my ($pkg, $file, $line, $sub, @other) = $end_phase ? caller(0) : caller($level);
     unless ($pkg || $end_phase) {
         confess "Could not find context at depth $level" unless $params{fudge};
-        ($pkg, $file, $line, $sub) = caller(--$level) while ($level >= 0 && !$pkg);
+        ($pkg, $file, $line, $sub, @other) = caller(--$level) while ($level >= 0 && !$pkg);
     }
 
     my $depth = $level;
@@ -460,6 +460,8 @@ sub context {
             nested => $hub->{nested},
             buffered => $hub->{buffered},
 
+            full_caller => [$pkg, $file, $line, $sub, @other],
+
             $$UUID_VIA ? (
                 huuid => $hub->{uuid},
                 uuid  => ${$UUID_VIA}->('context'),
@@ -595,6 +597,10 @@ sub _intercept {
     $ctx->stack->top; # Make sure there is a top hub before we begin.
     $ctx->stack->push($hub);
 
+    my $trace = $ctx->trace;
+    my $state = {};
+    $hub->clean_inherited(trace => $trace, state => $state);
+
     my ($ok, $err) = (1, undef);
     T2_SUBTEST_WRAPPER: {
         # Do not use 'try' cause it localizes __DIE__
@@ -611,7 +617,8 @@ sub _intercept {
     $hub->cull;
     $ctx->stack->pop($hub);
 
-    my $trace = $ctx->trace;
+    $hub->restore_inherited(trace => $trace, state => $state);
+
     $ctx->release;
 
     die $err unless $ok;
@@ -621,7 +628,8 @@ sub _intercept {
         && !$hub->no_ending
         && !$hub->ended;
 
-    return \@events;
+    require Test2::API::InterceptResult;
+    return Test2::API::InterceptResult->new_from_ref(\@events);
 }
 
 sub run_subtest {
@@ -841,38 +849,9 @@ generated by the test system:
         my_ok(0, "fail");
     };
 
-    my_ok(@$events == 2, "got 2 events, the pass and the fail");
-    my_ok($events->[0]->pass, "first event passed");
-    my_ok(!$events->[1]->pass, "second event failed");
-
-=head3 DEEP EVENT INTERCEPTION
-
-Normally C<intercept { ... }> only intercepts events sent to the main hub (as
-added by intercept itself). Nested hubs, such as those created by subtests,
-will not be intercepted. This is normally what you will still see the nested
-events by inspecting the subtest event. However there are times where you want
-to verify each event as it is sent, in that case use C<intercept_deep { ... }>.
-
-    my $events = intercept_Deep {
-        buffered_subtest foo => sub {
-            ok(1, "pass");
-        };
-    };
-
-C<$events> in this case will contain 3 items:
-
-=over 4
-
-=item The event from C<ok(1, "pass")>
-
-=item The plan event for the subtest
-
-=item The subtest event itself, with the first 2 events nested inside it as children.
-
-=back
-
-This lets you see the order in which the events were sent, unlike
-C<intercept { ... }> which only lets you see events as the main hub sees them.
+As of version 1.302178 this now returns an arrayref that is also an instance of
+L<Test2::API::InterceptResult>. See the L<Test2::API::InterceptResult>
+documentation for details on how to best use it.
 
 =head2 OTHER API FUNCTIONS
 
@@ -1161,8 +1140,13 @@ It will execute the codeblock, intercepting any generated events in the
 process. It will return an array reference with all the generated event
 objects. All events should be subclasses of L<Test2::Event>.
 
-This is a very low-level subtest tool. This is useful for writing tools which
-produce subtests. This is not intended for people simply writing tests.
+As of version 1.302178 the events array that is returned is blssed as an
+L<Test2::API::InterceptResult> instance. L<Test2::API::InterceptResult>
+Provides a helpful interface for filtering and/or inspecting the events list
+overall, or individual events within the list.
+
+This is intended to help you test your test code. This is not intended for
+people simply writing tests.
 
 =head2 run_subtest(...)
 
@@ -1679,7 +1663,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 2dd2852..55471bb 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Breakage;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Test2::Util qw/pkg_to_file/;
@@ -170,7 +170,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 177d9c4..ff438a6 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Context;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Carp qw/confess croak/;
@@ -1009,7 +1009,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index fbbb675..988f83d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Instance;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
 use Carp qw/confess carp/;
@@ -812,7 +812,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult.pm
new file mode 100644 (file)
index 0000000..c22e877
--- /dev/null
@@ -0,0 +1,634 @@
+package Test2::API::InterceptResult;
+use strict;
+use warnings;
+
+our $VERSION = '1.302181';
+
+use Scalar::Util qw/blessed/;
+use Test2::Util  qw/pkg_to_file/;
+use Storable     qw/dclone/;
+use Carp         qw/croak/;
+
+use Test2::API::InterceptResult::Squasher;
+use Test2::API::InterceptResult::Event;
+use Test2::API::InterceptResult::Hub;
+
+sub new {
+    croak "Called a method that creates a new instance in void context" unless defined wantarray;
+    my $class = shift;
+    bless([@_], $class);
+}
+
+sub new_from_ref {
+    croak "Called a method that creates a new instance in void context" unless defined wantarray;
+    bless($_[1], $_[0]);
+}
+
+sub clone { blessed($_[0])->new(@{dclone($_[0])}) }
+
+sub event_list { @{$_[0]} }
+
+sub _upgrade {
+    my $self = shift;
+    my ($event, %params) = @_;
+
+    my $blessed = blessed($event);
+
+    my $upgrade_class = $params{upgrade_class} ||= 'Test2::API::InterceptResult::Event';
+
+    return $event if $blessed && $event->isa($upgrade_class) && !$params{_upgrade_clone};
+
+    my $fd = dclone($blessed ? $event->facet_data : $event);
+
+    my $class = $params{result_class} ||= blessed($self);
+
+    if (my $parent = $fd->{parent}) {
+        $parent->{children} = $class->new_from_ref($parent->{children} || [])->upgrade(%params);
+    }
+
+    my $uc_file = pkg_to_file($upgrade_class);
+    require($uc_file) unless $INC{$uc_file};
+    return $upgrade_class->new(facet_data => $fd, result_class => $class);
+}
+
+sub hub {
+    my $self = shift;
+
+    my $hub = Test2::API::InterceptResult::Hub->new();
+    $hub->process($_) for @$self;
+    $hub->set_ended(1);
+
+    return $hub;
+}
+
+sub state {
+    my $self = shift;
+    my %params = @_;
+
+    my $hub = $self->hub;
+
+    my $out = {
+        map {($_ => scalar $hub->$_)} qw/count failed is_passing plan bailed_out skip_reason/
+    };
+
+    $out->{bailed_out} = $self->_upgrade($out->{bailed_out}, %params)->bailout_reason || 1
+        if $out->{bailed_out};
+
+    $out->{follows_plan} = $hub->check_plan;
+
+    return $out;
+}
+
+sub upgrade {
+    my $self = shift;
+    my %params = @_;
+
+    my @out = map { $self->_upgrade($_, %params, _upgrade_clone => 1) } @$self;
+
+    return blessed($self)->new_from_ref(\@out)
+        unless $params{in_place};
+
+    @$self = @out;
+    return $self;
+}
+
+sub squash_info {
+    my $self = shift;
+    my %params = @_;
+
+    my @out;
+
+    {
+        my $squasher = Test2::API::InterceptResult::Squasher->new(events => \@out);
+        # Clone to make sure we do not indirectly modify an existing one if it
+        # is already upgraded
+        $squasher->process($self->_upgrade($_, %params)->clone) for @$self;
+        $squasher->flush_down();
+    }
+
+    return blessed($self)->new_from_ref(\@out)
+        unless $params{in_place};
+
+    @$self = @out;
+    return $self;
+}
+
+sub asserts        { shift->grep(has_assert     => @_) }
+sub subtests       { shift->grep(has_subtest    => @_) }
+sub diags          { shift->grep(has_diags      => @_) }
+sub notes          { shift->grep(has_notes      => @_) }
+sub errors         { shift->grep(has_errors     => @_) }
+sub plans          { shift->grep(has_plan       => @_) }
+sub causes_fail    { shift->grep(causes_fail    => @_) }
+sub causes_failure { shift->grep(causes_failure => @_) }
+
+sub flatten         { shift->map(flatten        => @_) }
+sub briefs          { shift->map(brief          => @_) }
+sub summaries       { shift->map(summary        => @_) }
+sub subtest_results { shift->map(subtest_result => @_) }
+sub diag_messages   { shift->map(diag_messages  => @_) }
+sub note_messages   { shift->map(note_messages  => @_) }
+sub error_messages  { shift->map(error_messages => @_) }
+
+no warnings 'once';
+
+*map = sub {
+    my $self = shift;
+    my ($call, %params) = @_;
+
+    my $args = $params{args} ||= [];
+
+    return [map { local $_ = $self->_upgrade($_, %params); $_->$call(@$args) } @$self];
+};
+
+*grep = sub {
+    my $self = shift;
+    my ($call, %params) = @_;
+
+    my $args = $params{args} ||= [];
+
+    my @out = grep { local $_ = $self->_upgrade($_, %params); $_->$call(@$args) } @$self;
+
+    return blessed($self)->new_from_ref(\@out)
+        unless $params{in_place};
+
+    @$self = @out;
+    return $self;
+};
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::InterceptResult - Representation of a list of events.
+
+=head1 DESCRIPTION
+
+This class represents a list of events, normally obtained using C<intercept()>
+from L<Test2::API>.
+
+This class is intended for people who with to verify the results of test tools
+they write.
+
+This class provides methods to normalize, summarize, or map the list of events.
+The output of these operations makes verifying your testing tools and the
+events they generate significantly easier. In most cases this spares you from
+needing a deep understanding of the event/facet model.
+
+=head1 SYNOPSIS
+
+Usually you get an instance of this class when you use C<intercept()> from
+L<Test2::API>.
+
+    use Test2::V0;
+    use Test2::API qw/intercept/;
+
+    my $events = intercept {
+        ok(1, "pass");
+        ok(0, "fail");
+        todo "broken" => sub { ok(0, "fixme") };
+        plan 3;
+    };
+
+    # This is typically the most useful construct
+    # squash_info() merges assertions and diagnostics that are associated
+    #   (and returns a new instance with the modifications)
+    # flatten() condenses the facet data into the key details for each event
+    #   (and returns those structures in an arrayref)
+    is(
+        $events->squash_info->flatten(),
+        [
+            {
+                causes_failure => 0,
+
+                name => 'pass',
+                pass => 1,
+
+                trace_file => 'xxx.t',
+                trace_line => 5,
+            },
+            {
+                causes_failure => 1,
+
+                name => 'fail',
+                pass => 0,
+
+                trace_file => 'xxx.t',
+                trace_line => 6,
+
+                # There can be more than one diagnostics message so this is
+                # always an array when present.
+                diag => ["Failed test 'fail'\nat xxx.t line 6."],
+            },
+            {
+                causes_failure => 0,
+
+                name => 'fixme',
+                pass => 0,
+
+                trace_file => 'xxx.t',
+                trace_line => 7,
+
+                # There can be more than one diagnostics message or todo
+                # reason, so these are always an array when present.
+                todo => ['broken'],
+
+                # Diag message was turned into a note since the assertion was
+                # TODO
+                note => ["Failed test 'fixme'\nat xxx.t line 7."],
+            },
+            {
+                causes_failure => 0,
+
+                plan => 3,
+
+                trace_file => 'xxx.t',
+                trace_line => 8,
+            },
+        ],
+        "Flattened events look like we expect"
+    );
+
+See L<Test2::API::InterceptResult::Event> for a full description of what
+C<flatten()> provides for each event.
+
+=head1 METHODS
+
+Please note that no methods modify the original instance unless asked to do so.
+
+=head2 CONSTRUCTION
+
+=over 4
+
+=item $events = Test2::API::InterceptResult->new(@EVENTS)
+
+=item $events = Test2::API::InterceptResult->new_from_ref(\@EVENTS)
+
+These create a new instance of Test2::API::InterceptResult from the given
+events.
+
+In the first form a new blessed arrayref is returned. In the 'new_from_ref'
+form the reference you pass in is directly blessed.
+
+Both of these will throw an exception if called in void context. This is mainly
+important for the 'filtering' methods listed below which normally return a new
+instance, they throw an exception in such cases as it probably means someone
+meant to filter the original in place.
+
+=item $clone = $events->clone()
+
+Make a clone of the original events. Note that this is a deep copy, the entire
+structure is duplicated. This uses C<dclone> from L<Storable> to achieve the
+deep clone.
+
+=back
+
+=head2 NORMALIZATION
+
+=over 4
+
+=item @events = $events->event_list
+
+This returns all the events in list-form.
+
+=item $hub = $events->hub
+
+This returns a new L<Test2::Hub> instance that has processed all the events
+contained in the instance. This gives you a simple way to inspect the state
+changes your events cause.
+
+=item $state = $events->state
+
+This returns a summary of the state of a hub after processing all the events.
+
+    {
+        count        => 2,      # Number of assertions made
+        failed       => 1,      # Number of test failures seen
+        is_passing   => 0,      # Boolean, true if the test would be passing
+                                # after the events are processed.
+
+        plan         => 2,      # Plan, either a number, undef, 'SKIP', or 'NO PLAN'
+        follows_plan => 1,      # True if there is a plan and it was followed.
+                                # False if the plan and assertions did not
+                                # match, undef if no plan was present in the
+                                # event list.
+
+        bailed_out   => undef,  # undef unless there was a bail-out in the
+                                # events in which case this will be a string
+                                # explaining why there was a bailout, if no
+                                # reason was given this will simply be set to
+                                # true (1).
+
+        skip_reason  => undef,  # If there was a skip_all this will give the
+                                # reason.
+    }
+
+
+=item $new = $events->upgrade
+
+=item $events->upgrade(in_place => $BOOL)
+
+B<Note:> This normally returns a new instance, leaving the original unchanged.
+If you call it in void context it will throw an exception. If you want to
+modify the original you must pass in the C<< in_place => 1 >> option. You may
+call this in void context when you ask to modify it in place. The in-place form
+returns the instance that was modified so you can chain methods.
+
+This will create a clone of the list where all events have been converted into
+L<Test2::API::InterceptResult::Event> instances. This is extremely helpful as
+L<Test2::API::InterceptResult::Event> provide a much better interface for
+working with events. This allows you to avoid thinking about legacy event
+types.
+
+This also means your tests against the list are not fragile if the tool
+you are testing randomly changes what type of events it generates (IE Changing
+from L<Test2::Event::Ok> to L<Test2::Event::Pass>, both make assertions and
+both will normalize to identical (or close enough)
+L<Test2::API::InterceptResult::Event> instances.
+
+Really you almost always want this, the only reason it is not done
+automatically is to make sure the C<intercept()> tool is backwards compatible.
+
+=item $new = $events->squash_info
+
+=item $events->squash_info(in_place => $BOOL)
+
+B<Note:> This normally returns a new instance, leaving the original unchanged.
+If you call it in void context it will throw an exception. If you want to
+modify the original you must pass in the C<< in_place => 1 >> option. You may
+call this in void context when you ask to modify it in place. The in-place form
+returns the instance that was modified so you can chain methods.
+
+B<Note:> All events in the new or modified instance will be converted to
+L<Test2::API::InterceptResult::Event> instances. There is no way to avoid this,
+the squash operation requires the upgraded event class.
+
+L<Test::More> and many other legacy tools would send notes, diags, and
+assertions as seperate events. A subtest in L<Test::More> would send a note
+with the subtest name, the subtest assertion, and finally a diagnostics event
+if the subtest failed. This method will normalize things by squashing the note
+and diag into the same event as the subtest (This is different from putting
+them into the subtest, which is not what happens).
+
+=back
+
+=head2 FILTERING
+
+B<Note:> These normally return new instances, leaving the originals unchanged.
+If you call them in void context they will throw exceptions. If you want to
+modify the originals you must pass in the C<< in_place => 1 >> option. You may
+call these in void context when you ask to modify them in place. The in-place
+forms return the instance that was modified so you can chain methods.
+
+=head3 %PARAMS
+
+These all accept the same 2 optional parameters:
+
+=over 4
+
+=item in_place => $BOOL
+
+When true the method will modify the instance in place instead of returning a
+new instance.
+
+=item args => \@ARGS
+
+If you wish to pass parameters into the event method being used for filtering,
+you may do so here.
+
+=back
+
+=head3 METHODS
+
+=over 4
+
+=item $events->grep($CALL, %PARAMS)
+
+This is essentially:
+
+    Test2::API::InterceptResult->new(
+        grep { $_->$CALL( @{$PARAMS{args}} ) } $self->event_list,
+    );
+
+B<Note:> that $CALL is called on an upgraded version of the event, though
+the events returned will be the original ones, not the upgraded ones.
+
+$CALL may be either the name of a method on
+L<Test2::API::InterceptResult::Event>, or a coderef.
+
+=item $events->asserts(%PARAMS)
+
+This is essentially:
+
+    $events->grep(has_assert => @{$PARAMS{args}})
+
+It returns a new instance containing only the events that made assertions.
+
+=item $events->subtests(%PARAMS)
+
+This is essentially:
+
+    $events->grep(has_subtest => @{$PARAMS{args}})
+
+It returns a new instance containing only the events that have subtests.
+
+=item $events->diags(%PARAMS)
+
+This is essentially:
+
+    $events->grep(has_diags => @{$PARAMS{args}})
+
+It returns a new instance containing only the events that have diags.
+
+=item $events->notes(%PARAMS)
+
+This is essentially:
+
+    $events->grep(has_notes => @{$PARAMS{args}})
+
+It returns a new instance containing only the events that have notes.
+
+=item $events->errors(%PARAMS)
+
+B<Note:> Errors are NOT failing assertions. Failing assertions are a different
+thing.
+
+This is essentially:
+
+    $events->grep(has_errors => @{$PARAMS{args}})
+
+It returns a new instance containing only the events that have errors.
+
+=item $events->plans(%PARAMS)
+
+This is essentially:
+
+    $events->grep(has_plan => @{$PARAMS{args}})
+
+It returns a new instance containing only the events that set the plan.
+
+=item $events->causes_fail(%PARAMS)
+
+=item $events->causes_failure(%PARAMS)
+
+These are essentially:
+
+    $events->grep(causes_fail    => @{$PARAMS{args}})
+    $events->grep(causes_failure => @{$PARAMS{args}})
+
+B<Note:> C<causes_fail()> and C<causes_failure()> are both aliases for
+eachother in events, so these methods are effectively aliases here as well.
+
+It returns a new instance containing only the events that cause failure.
+
+=back
+
+=head2 MAPPING
+
+These methods B<ALWAYS> return an arrayref.
+
+B<Note:> No methods on L<Test2::API::InterceptResult::Event> alter the event in
+any way.
+
+B<Important Notes about Events>:
+
+L<Test2::API::InterceptResult::Event> was tailor-made to be used in
+event-lists. Most methods that are not applicable to a given event will return
+an empty list, so you normally do not need to worry about unwanted C<undef>
+values or exceptions being thrown. Mapping over event methods is an entended
+use, so it works well to produce lists.
+
+B<Exceptions to the rule:>
+
+Some methods such as C<causes_fail> always return a boolean true or false for
+all events. Any method prefixed with C<the_> conveys the intent that the event
+should have exactly 1 of something, so those will throw an exception when that
+condition is not true.
+
+=over 4
+
+=item $arrayref = $events->map($CALL, %PARAMS)
+
+This is essentially:
+
+    [ map { $_->$CALL(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+$CALL may be either the name of a method on
+L<Test2::API::InterceptResult::Event>, or a coderef.
+
+=item $arrayref = $events->flatten(%PARAMS)
+
+This is essentially:
+
+    [ map { $_->flatten(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+It returns a new list of flattened structures.
+
+See L<Test2::API::InterceptResult::Event> for details on what C<flatten()>
+returns.
+
+=item $arrayref = $events->briefs(%PARAMS)
+
+This is essentially:
+
+    [ map { $_->briefs(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+It returns a new list of event briefs.
+
+See L<Test2::API::InterceptResult::Event> for details on what C<brief()>
+returns.
+
+=item $arrayref = $events->summaries(%PARAMS)
+
+This is essentially:
+
+    [ map { $_->summaries(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+It returns a new list of event summaries.
+
+See L<Test2::API::InterceptResult::Event> for details on what C<summary()>
+returns.
+
+=item $arrayref = $events->subtest_results(%PARAMS)
+
+This is essentially:
+
+    [ map { $_->subtest_result(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+It returns a new list of event summaries.
+
+See L<Test2::API::InterceptResult::Event> for details on what
+C<subtest_result()> returns.
+
+=item $arrayref = $events->diag_messages(%PARAMS)
+
+This is essentially:
+
+    [ map { $_->diag_messages(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+It returns a new list of diagnostic messages (strings).
+
+See L<Test2::API::InterceptResult::Event> for details on what
+C<diag_messages()> returns.
+
+=item $arrayref = $events->note_messages(%PARAMS)
+
+This is essentially:
+
+    [ map { $_->note_messages(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+It returns a new list of notification messages (strings).
+
+See L<Test2::API::InterceptResult::Event> for details on what
+C<note_messages()> returns.
+
+=item $arrayref = $events->error_messages(%PARAMS)
+
+This is essentially:
+
+    [ map { $_->error_messages(@{ $PARAMS{args} }) } $events->upgrade->event_list ];
+
+It returns a new list of error messages (strings).
+
+See L<Test2::API::InterceptResult::Event> for details on what
+C<error_messages()> returns.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<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
diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm
new file mode 100644 (file)
index 0000000..4e80820
--- /dev/null
@@ -0,0 +1,1087 @@
+package Test2::API::InterceptResult::Event;
+use strict;
+use warnings;
+
+our $VERSION = '1.302181';
+
+use List::Util   qw/first/;
+use Test2::Util  qw/pkg_to_file/;
+use Scalar::Util qw/reftype blessed/;
+
+use Storable qw/dclone/;
+use Carp     qw/confess croak/;
+
+use Test2::API::InterceptResult::Facet;
+use Test2::API::InterceptResult::Hub;
+
+use Test2::Util::HashBase qw{
+    +causes_failure
+    <facet_data
+    <result_class
+};
+
+my %FACETS;
+BEGIN {
+    local $@;
+    local *plugins;
+    if (eval { require Module::Pluggable; 1 }) {
+        Module::Pluggable->import(
+            # We will replace the sub later
+            require          => 1,
+            on_require_error => sub { 1 },
+            search_path      => ['Test2::EventFacet'],
+            max_depth        => 3,
+            min_depth        => 3,
+        );
+
+        for my $facet_type (__PACKAGE__->plugins) {
+            my ($key, $list);
+            eval {
+                $key  = $facet_type->facet_key;
+                $list = $facet_type->is_list;
+            };
+            next unless $key && defined($list);
+
+            $FACETS{$key} = {list => $list, class => $facet_type, loaded => 1};
+        }
+    }
+
+    $FACETS{__GENERIC__} = {class => 'Test2::API::InterceptResult::Facet', loaded => 1};
+}
+
+sub facet_map { \%FACETS }
+
+sub facet_info {
+    my $facet = pop;
+
+    return $FACETS{$facet} if exists $FACETS{$facet};
+
+    my $mname = ucfirst(lc($facet));
+    $mname =~ s/s$//;
+
+    for my $name ($mname, "${mname}s") {
+        my $file  = "Test2/EventFacet/$name.pm";
+        my $class = "Test2::EventFacet::$name";
+
+        local $@;
+        my $ok = eval {
+            require $file;
+
+            my $key = $class->facet_key;
+            my $list = $class->is_list;
+
+            $FACETS{$key} = {list => $list, class => $class, loaded => 1};
+            $FACETS{$facet} = $FACETS{$key} if $facet ne $key;
+
+            1;
+        };
+
+        return $FACETS{$facet} if $ok && $FACETS{$facet};
+    }
+
+    return $FACETS{$facet} = $FACETS{__GENERIC__};
+}
+
+sub init {
+    my $self = shift;
+
+    my $rc = $self->{+RESULT_CLASS} ||= 'Test2::API::InterceptResult';
+    my $rc_file = pkg_to_file($rc);
+    require($rc_file) unless $INC{$rc_file};
+
+    my $fd = $self->{+FACET_DATA} ||= {};
+
+    for my $facet (keys %$fd) {
+        my $finfo = $self->facet_info($facet);
+        my $is_list = $finfo->{list};
+        next unless defined $is_list;
+
+        my $type = reftype($fd->{$facet});
+
+        if ($is_list) {
+            confess "Facet '$facet' is a list facet, but got '$type' instead of an arrayref"
+                unless $type eq 'ARRAY';
+
+            for my $item (@{$fd->{$facet}}) {
+                my $itype = reftype($item);
+                next if $itype eq 'HASH';
+
+                confess "Got item type '$itype' in list-facet '$facet', all items must be hashrefs";
+            }
+        }
+        else {
+            confess "Facet '$facet' is an only-one facet, but got '$type' instead of a hashref"
+                unless $type eq 'HASH';
+        }
+    }
+}
+
+sub clone {
+    my $self = shift;
+    my $class = blessed($self);
+
+    my %data = %$self;
+
+    $data{+FACET_DATA} = dclone($data{+FACET_DATA});
+
+    return bless(\%data, $class);
+}
+
+sub _facet_class {
+    my $self = shift;
+    my ($name) = @_;
+
+    my $spec  = $self->facet_info($name);
+    my $class = $spec->{class};
+    unless ($spec->{loaded}) {
+        my $file = pkg_to_file($class);
+        require $file unless $INC{$file};
+        $spec->{loaded} = 1;
+    }
+
+    return $class;
+}
+
+sub the_facet {
+    my $self = shift;
+    my ($name) = @_;
+
+    return undef unless defined $self->{+FACET_DATA}->{$name};
+
+    my $data = $self->{+FACET_DATA}->{$name};
+
+    my $type = reftype($data) or confess "Facet '$name' has a value that is not a reference, this should not happen";
+
+    return $self->_facet_class($name)->new(%{dclone($data)})
+        if $type eq 'HASH';
+
+    if ($type eq 'ARRAY') {
+        return undef unless @$data;
+        croak "'the_facet' called for facet '$name', but '$name' has '" . @$data . "' items" if @$data != 1;
+        return $self->_facet_class($name)->new(%{dclone($data->[0])});
+    }
+
+    die "Invalid facet data type: $type";
+}
+
+sub facet {
+    my $self = shift;
+    my ($name) = @_;
+
+    return () unless exists $self->{+FACET_DATA}->{$name};
+
+    my $data = $self->{+FACET_DATA}->{$name};
+
+    my $type = reftype($data) or confess "Facet '$name' has a value that is not a reference, this should not happen";
+
+    my @out;
+    @out = ($data)  if $type eq 'HASH';
+    @out = (@$data) if $type eq 'ARRAY';
+
+    my $class = $self->_facet_class($name);
+
+    return map { $class->new(%{dclone($_)}) } @out;
+}
+
+sub causes_failure {
+    my $self = shift;
+
+    return $self->{+CAUSES_FAILURE}
+        if exists $self->{+CAUSES_FAILURE};
+
+    my $hub = Test2::API::InterceptResult::Hub->new();
+    $hub->process($self);
+
+    return $self->{+CAUSES_FAILURE} = ($hub->is_passing ? 0 : 1);
+}
+
+sub causes_fail { shift->causes_failure }
+
+sub trace         { $_[0]->facet('trace') }
+sub the_trace     { $_[0]->the_facet('trace') }
+sub frame         { my $t = $_[0]->the_trace or return undef; $t->{frame} || undef }
+sub trace_details { my $t = $_[0]->the_trace or return undef; $t->{details} || undef }
+sub trace_package { my $f = $_[0]->frame or return undef; $f->[0] || undef }
+sub trace_file    { my $f = $_[0]->frame or return undef; $f->[1] || undef }
+sub trace_line    { my $f = $_[0]->frame or return undef; $f->[2] || undef }
+sub trace_subname { my $f = $_[0]->frame or return undef; $f->[3] || undef }
+sub trace_tool    { my $f = $_[0]->frame or return undef; $f->[3] || undef }
+
+sub trace_signature { my $t = $_[0]->the_trace or return undef; Test2::EventFacet::Trace::signature($t) || undef }
+
+sub brief {
+    my $self = shift;
+
+    my @try = qw{
+        bailout_brief
+        error_brief
+        assert_brief
+        plan_brief
+    };
+
+    for my $meth (@try) {
+        my $got = $self->$meth or next;
+        return $got;
+    }
+
+    return;
+}
+
+sub flatten {
+    my $self = shift;
+    my %params = @_;
+
+    my $todo = {%{$self->{+FACET_DATA}}};
+    delete $todo->{hubs};
+    delete $todo->{meta};
+    delete $todo->{trace};
+
+    my $out = $self->summary;
+    delete $out->{brief};
+    delete $out->{facets};
+    delete $out->{trace_tool};
+    delete $out->{trace_details} unless defined($out->{trace_details});
+
+    for my $tagged (grep { my $finfo = $self->facet_info($_); $finfo->{list} && $finfo->{class}->can('tag') } keys %FACETS, keys %$todo) {
+        my $set = delete $todo->{$tagged} or next;
+
+        my $fd = $self->{+FACET_DATA};
+        my $has_assert = $self->has_assert;
+        my $has_parent = $self->has_subtest;
+        my $has_fatal_error = $self->has_errors && grep { $_->{fail} } $self->errors;
+
+        next if $tagged eq 'amnesty' && !($has_assert || $has_parent || $has_fatal_error);
+
+        for my $item (@$set) {
+            push @{$out->{lc($item->{tag})}} => $item->{fail} ? "FATAL: $item->{details}" : $item->{details};
+        }
+    }
+
+    if (my $assert = delete $todo->{assert}) {
+        $out->{pass} = $assert->{pass};
+        $out->{name} = $assert->{details};
+    }
+
+    if (my $parent = delete $todo->{parent}) {
+        delete $out->{subtest}->{bailed_out}  unless defined $out->{subtest}->{bailed_out};
+        delete $out->{subtest}->{skip_reason} unless defined $out->{subtest}->{skip_reason};
+
+        if (my $res = $self->subtest_result) {
+            my $state = $res->state;
+            delete $state->{$_} for grep { !defined($state->{$_}) } keys %$state;
+            $out->{subtest} = $state;
+            $out->{subevents} = $res->flatten(%params)
+                if $params{include_subevents};
+        }
+    }
+
+    if (my $control = delete $todo->{control}) {
+        if ($control->{halt}) {
+            $out->{bailed_out} = $control->{details} || 1;
+        }
+        elsif(defined $control->{details}) {
+            $out->{control} = $control->{details};
+        }
+    }
+
+    if (my $plan = delete $todo->{plan}) {
+        $out->{plan} = $self->plan_brief;
+        $out->{plan} =~ s/^PLAN\s*//;
+    }
+
+    for my $other (keys %$todo) {
+        my $data = $todo->{$other} or next;
+
+        if (reftype($data) eq 'ARRAY') {
+            if (!$out->{$other} || reftype($out->{$other}) eq 'ARRAY') {
+                for my $item (@$data) {
+                    push @{$out->{$other}} => $item->{details} if defined $item->{details};
+                }
+            }
+        }
+        else {
+            $out->{$other} = $data->{details} if defined($data->{details}) && !defined($out->{$other});
+        }
+    }
+
+    if (my $fields = $params{fields}) {
+        $out = { map {exists($out->{$_}) ? ($_ => $out->{$_}) : ()} @$fields };
+    }
+
+    if (my $remove = $params{remove}) {
+        delete $out->{$_} for @$remove;
+    }
+
+    return $out;
+}
+
+sub summary {
+    my $self = shift;
+    my %params = @_;
+
+    my $out = {
+        brief => $self->brief || '',
+
+        causes_failure => $self->causes_failure,
+
+        trace_line    => $self->trace_line,
+        trace_file    => $self->trace_file,
+        trace_tool    => $self->trace_subname,
+        trace_details => $self->trace_details,
+
+        facets => [ sort keys(%{$self->{+FACET_DATA}}) ],
+    };
+
+    if (my $fields = $params{fields}) {
+        $out = { map {exists($out->{$_}) ? ($_ => $out->{$_}) : ()} @$fields };
+    }
+
+    if (my $remove = $params{remove}) {
+        delete $out->{$_} for @$remove;
+    }
+
+    return $out;
+}
+
+sub has_assert { $_[0]->{+FACET_DATA}->{assert} ? 1 : 0 }
+sub the_assert { $_[0]->the_facet('assert') }
+sub assert     { $_[0]->facet('assert') }
+
+sub assert_brief {
+    my $self = shift;
+
+    my $fd = $self->{+FACET_DATA};
+    my $as = $fd->{assert} or return;
+    my $am = $fd->{amnesty};
+
+    my $out = $as->{pass} ? "PASS" : "FAIL";
+    $out .= " with amnesty" if $am;
+    return $out;
+}
+
+sub has_subtest { $_[0]->{+FACET_DATA}->{parent} ? 1 : 0 }
+sub the_subtest { $_[0]->the_facet('parent') }
+sub subtest     { $_[0]->facet('parent') }
+
+sub subtest_result {
+    my $self = shift;
+
+    my $parent = $self->{+FACET_DATA}->{parent} or return;
+    my $children = $parent->{children} || [];
+
+    $children = $self->{+RESULT_CLASS}->new(@$children)->upgrade
+        unless blessed($children) && $children->isa($self->{+RESULT_CLASS});
+
+    return $children;
+}
+
+sub has_bailout { $_[0]->bailout ? 1 : 0 }
+sub the_bailout { my ($b) = $_[0]->bailout; $b }
+
+sub bailout {
+    my $self = shift;
+    my $control = $self->{+FACET_DATA}->{control} or return;
+    return $control if $control->{halt};
+    return;
+}
+
+sub bailout_brief {
+    my $self = shift;
+    my $bo = $self->bailout or return;
+
+    my $reason = $bo->{details} or return "BAILED OUT";
+    return "BAILED OUT: $reason";
+}
+
+sub bailout_reason {
+    my $self = shift;
+    my $bo = $self->bailout or return;
+    return $bo->{details} || '';
+}
+
+sub has_plan { $_[0]->{+FACET_DATA}->{plan} ? 1 : 0 }
+sub the_plan { $_[0]->the_facet('plan') }
+sub plan     { $_[0]->facet('plan') }
+
+sub plan_brief {
+    my $self = shift;
+
+    my $plan = $self->{+FACET_DATA}->{plan} or return;
+
+    my $base = $self->_plan_brief($plan);
+
+    my $reason = $plan->{details} or return $base;
+    return "$base: $reason";
+}
+
+sub _plan_brief {
+    my $self = shift;
+    my ($plan) = @_;
+
+    return 'NO PLAN' if $plan->{none};
+    return "SKIP ALL" if $plan->{skip} || !$plan->{count};
+    return "PLAN $plan->{count}";
+}
+
+sub has_amnesty     { $_[0]->{+FACET_DATA}->{amnesty} ? 1 : 0 }
+sub the_amnesty     { $_[0]->the_facet('amnesty') }
+sub amnesty         { $_[0]->facet('amnesty') }
+sub amnesty_reasons { map { $_->{details} } $_[0]->amnesty }
+
+sub has_todos    { &first(sub { uc($_->{tag}) eq 'TODO' }, $_[0]->amnesty) ? 1 : 0 }
+sub todos        {       grep { uc($_->{tag}) eq 'TODO' }  $_[0]->amnesty          }
+sub todo_reasons {       map  { $_->{details} || 'TODO' }  $_[0]->todos            }
+
+sub has_skips    { &first(sub { uc($_->{tag}) eq 'SKIP' }, $_[0]->amnesty) ? 1 : 0 }
+sub skips        {       grep { uc($_->{tag}) eq 'SKIP' }  $_[0]->amnesty          }
+sub skip_reasons {       map  { $_->{details} || 'SKIP' }  $_[0]->skips            }
+
+my %TODO_OR_SKIP = (SKIP => 1, TODO => 1);
+sub has_other_amnesty     { &first( sub { !$TODO_OR_SKIP{uc($_->{tag})}            }, $_[0]->amnesty) ? 1 : 0 }
+sub other_amnesty         {        grep { !$TODO_OR_SKIP{uc($_->{tag})}            }  $_[0]->amnesty          }
+sub other_amnesty_reasons {        map  { $_->{details} ||  $_->{tag} || 'AMNESTY' }  $_[0]->other_amnesty    }
+
+sub has_errors     { $_[0]->{+FACET_DATA}->{errors} ? 1 : 0 }
+sub the_errors     { $_[0]->the_facet('errors') }
+sub errors         { $_[0]->facet('errors') }
+sub error_messages { map { $_->{details} || $_->{tag} || 'ERROR' } $_[0]->errors }
+
+sub error_brief {
+    my $self = shift;
+
+    my $errors = $self->{+FACET_DATA}->{errors} or return;
+
+    my $base = @$errors > 1 ? "ERRORS" : "ERROR";
+
+    return $base unless @$errors;
+
+    my ($msg, @extra) = split /[\n\r]+/, $errors->[0]->{details};
+
+    my $out = "$base: $msg";
+
+    $out .= " [...]" if @extra || @$errors > 1;
+
+    return $out;
+}
+
+sub has_info      { $_[0]->{+FACET_DATA}->{info} ? 1 : 0 }
+sub the_info      { $_[0]->the_facet('info') }
+sub info          { $_[0]->facet('info') }
+sub info_messages { map { $_->{details} } $_[0]->info }
+
+sub has_diags { &first(sub { uc($_->{tag}) eq 'DIAG' }, $_[0]->info) ? 1 : 0 }
+sub diags         {   grep { uc($_->{tag}) eq 'DIAG' }  $_[0]->info          }
+sub diag_messages {   map  { $_->{details} || 'DIAG' }  $_[0]->diags         }
+
+sub has_notes { &first(sub { uc($_->{tag}) eq 'NOTE' }, $_[0]->info) ? 1 : 0 }
+sub notes         {   grep { uc($_->{tag}) eq 'NOTE' }  $_[0]->info          }
+sub note_messages {   map  { $_->{details} || 'NOTE' }  $_[0]->notes         }
+
+my %NOTE_OR_DIAG = (NOTE => 1, DIAG => 1);
+sub has_other_info { &first(sub { !$NOTE_OR_DIAG{uc($_->{tag})}         }, $_[0]->info) ? 1 : 0 }
+sub other_info          {  grep { !$NOTE_OR_DIAG{uc($_->{tag})}         }  $_[0]->info          }
+sub other_info_messages {  map  { $_->{details} ||  $_->{tag} || 'INFO' }  $_[0]->other_info    }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::InterceptResult::Event - Representation of an event for use in
+testing other test tools.
+
+=head1 DESCRIPTION
+
+C<intercept { ... }> from L<Test2::API> returns an instance of
+L<Test2::API::InterceptResult> which is a blessed arrayref of
+L<Test2::API::InterceptResult::Event> objects.
+
+This POD documents the methods of these events, which are mainly provided for
+you to use when testing your test tools.
+
+=head1 SYNOPSIS
+
+    use Test2::V0;
+    use Test2::API qw/intercept/;
+
+    my $events = intercept {
+        ok(1, "A passing assertion");
+        plan(1);
+    };
+
+    # This will convert all events into instances of
+    # Test2::API::InterceptResult::Event. Until we do this they are the
+    # original Test::Event::* instances
+    $events->upgrade(in_place => 1);
+
+    # Now we can get individual events in this form
+    my $assert = $events->[0];
+    my $plan   = $events->[1];
+
+    # Or we can operate on all events at once:
+    my $flattened = $events->flatten;
+    is(
+        $flattened,
+        [
+          {
+            causes_failure => 0,
+
+            name => 'A passing assertion',
+            pass => 1,
+
+            trace_file => 'xxx.t',
+            trace_line => 5,
+          },
+          {
+            causes_failure => 0,
+
+            plan => 1,
+
+            trace_file => 'xxx.t',
+            trace_line => 6,
+          },
+        ],
+        "Flattened both events and returned an arrayref of the results
+    );
+
+=head1 METHODS
+
+=head2 !!! IMPORTANT NOTES ON DESIGN !!!
+
+Please pay attention to what these return, many return a scalar when
+applicable or an empty list when not (as opposed to undef). Many also always
+return a list of 0 or more items. Some always return a scalar. Note that none
+of the methods care about context, their behavior is consistent regardless of
+scalar, list, or void context.
+
+This was done because this class was specifically designed to be used in a list
+and generate more lists in bulk operations. Sometimes in a map you want nothing
+to show up for the event, and you do not want an undef in its place. In general
+single event instances are not going to be used alone, though that is allowed.
+
+As a general rule any method prefixed with C<the_> implies the event should
+have exactly 1 of the specified item, and and exception will be thrown if there
+are 0, or more than 1 of the item.
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item $hashref = $event->facet_data
+
+This will return the facet data hashref, which is all Test2 cares about for any
+given event.
+
+=item $class = $event->result_class
+
+This is normally L<Test2::API::InterceptResult>. This is set at construction so
+that subtest results can be turned into instances of it on demand.
+
+=back
+
+=head2 DUPLICATION
+
+=over 4
+
+=item $copy = $event->clone
+
+Create a deep copy of the event. Modifying either event will not effect the
+other.
+
+=back
+
+=head2 CONDENSED MULTI-FACET DATA
+
+=over 4
+
+=item $bool = $event->causes_failure
+
+=item $bool = $event->causes_fail
+
+These are both aliases of the same functionality.
+
+This will always return either a true value, or a false value. This never
+returns a list.
+
+This method may be relatively slow (still super fast) because it determines
+pass or fail by creating an instance of L<Test2::Hub> and asking it to process
+the event, and then asks the hub for its pass/fail state. This is slower than
+bulding in logic to do the check, but it is more reliable as it will always
+tell you what the hub thinks, so the logic will never be out of date relative
+to the Test2 logic that actually cares.
+
+=item STRING_OR_EMPTY_LIST = $event->brief
+
+Not all events have a brief, some events are not rendered by the formatter,
+others have no "brief" data worth seeing. When this is the case an empty list
+is returned. This is done intentionally so it can be used in a map operation
+without having C<undef> being included in the result.
+
+When a brief can be generated it is always a single 1-line string, and is
+returned as-is, not in a list.
+
+Possible briefs:
+
+    # From control facets
+    "BAILED OUT"
+    "BAILED OUT: $why"
+
+    # From error facets
+    "ERROR"
+    "ERROR: $message"
+    "ERROR: $partial_message [...]"
+    "ERRORS: $first_error_message [...]"
+
+    # From assert facets
+    "PASS"
+    "FAIL"
+    "PASS with amnesty"
+    "FAIL with amnesty"
+
+    # From plan facets
+    "PLAN $count"
+    "NO PLAN"
+    "SKIP ALL"
+    "SKIP ALL: $why"
+
+Note that only the first applicable brief is returned. This is essnetially a
+poor-mans TAP that only includes facets that could (but not necessarily do)
+cause a failure.
+
+=item $hashref = $event->flatten
+
+=item $hashref = $event->flatten(include_subevents => 1)
+
+This ALWAYS returns a hashref. This puts all the most useful data for the most
+interesting facets into a single hashref for easy validation.
+
+If there are no meaningful facets this will return an empty hashref.
+
+If given the 'include_subevents' parameter it will also include subtest data:
+
+Here is a list of EVERY possible field. If a field is not applicable it will
+not be present.
+
+=over 4
+
+=item always present
+
+        causes_failure => 1,    # Always present
+
+=item Present if the event has a trace facet
+
+        trace_line    => 42,
+        trace_file    => 'Foo/Bar.pm',
+        trace_details => 'Extra trace details',    # usually not present
+
+=item If an assertion is present
+
+        pass => 0,
+        name => "1 + 1 = 2, so math works",
+
+=item If a plan is present:
+
+        plan => $count_or_SKIP_ALL_or_NO_PLAN,
+
+=item If amnesty facets are present
+
+You get an array for each type that is present.
+
+        todo => [    # Yes you could be under multiple todos, this will list them all.
+            "I will fix this later",
+            "I promise to fix these",
+        ],
+
+        skip => ["This will format the main drive, do not run"],
+
+        ... => ["Other amnesty"]
+
+=item If Info (note/diag) facets are present
+
+You get an arrayref for any that are present, the key is not defined if they are not present.
+
+        diag => [
+            "Test failed at Foo/Bar.pm line 42",
+            "You forgot to tie your boots",
+        ],
+
+        note => ["Your boots are red"],
+
+        ...  => ["Other info"],
+
+=item If error facets are present
+
+Always an arrayref
+
+        error => [
+            "non fatal error (does not cause test failure, just an FYI",
+            "FATAL: This is a fatal error (causes failure)",
+        ],
+
+        # Errors can have alternative tags, but in practice are always 'error',
+        # listing this for completeness.
+        ... => [ ... ]
+
+=item Present if the event is a subtest
+
+        subtest => {
+            count      => 2,    # Number of assertions made
+            failed     => 1,    # Number of test failures seen
+            is_passing => 0,    # Boolean, true if the test would be passing
+                                # after the events are processed.
+
+            plan         => 2,  # Plan, either a number, undef, 'SKIP', or 'NO PLAN'
+            follows_plan => 1,  # True if there is a plan and it was followed.
+                                # False if the plan and assertions did not
+                                # match, undef if no plan was present in the
+                                # event list.
+
+            bailed_out => "foo",    # if there was a bail-out in the
+                                    # events in this will be a string explaining
+                                    # why there was a bailout, if no reason was
+                                    # given this will simply be set to true (1).
+
+            skip_reason => "foo",   # If there was a skip_all this will give the
+                                    # reason.
+        },
+
+if C<< (include_subtest => 1) >> was provided as a parameter then the following
+will be included. This is the result of turning all subtest child events into
+an L<Test2::API::InterceptResult> instance and calling the C<flatten> method on
+it.
+
+        subevents => Test2::API::InterceptResult->new(@child_events)->flatten(...),
+
+=item If a bail-out is being requested
+
+If no reason was given this will be set to 1.
+
+        bailed_out => "reason",
+
+=back
+
+=item $hashref = $event->summary()
+
+This returns a limited summary. See C<flatten()>, which is usually a better
+option.
+
+    {
+        brief => $event->brief || '',
+
+        causes_failure => $event->causes_failure,
+
+        trace_line    => $event->trace_line,
+        trace_file    => $event->trace_file,
+        trace_tool    => $event->trace_subname,
+        trace_details => $event->trace_details,
+
+        facets => [ sort keys(%{$event->{+FACET_DATA}}) ],
+    }
+
+=back
+
+=head2 DIRECT ARBITRARY FACET ACCESS
+
+=over 4
+
+=item @list_of_facets = $event->facet($name)
+
+This always returns a list of 0 or more items. This fetches the facet instances
+from the event. For facets like 'assert' this will always return 0 or 1
+item. For events like 'info' (diags, notes) this will return 0 or more
+instances, once for each instance of the facet.
+
+These will be blessed into the proper L<Test2::EventFacet> subclass. If no
+subclass can be found it will be blessed as an
+L<Test2::API::InterceptResult::Facet> generic facet class.
+
+=item $undef_or_facet = $event->the_facet($name)
+
+If you know you will have exactly 1 instance of a facet you can call this.
+
+If you are correct and there is exactly one instance of the facet it will
+always return the hashref.
+
+If there are 0 instances of the facet this will reutrn undef, not an empty
+list.
+
+If there are more than 1 instance this will throw an exception because your
+assumption was incorrect.
+
+=back
+
+=head2 TRACE FACET
+
+=over 4
+
+=item @list_of_facets = $event->trace
+
+TODO
+
+=item $undef_or_hashref = $event->the_trace
+
+This returns the trace hashref, or undef if it is not present.
+
+=item $undef_or_arrayref = $event->frame
+
+If a trace is present, and has a caller frame, this will be an arrayref:
+
+    [$package, $file, $line, $subname]
+
+If the trace is not present, or has no caller frame this will return undef.
+
+=item $undef_or_string = $event->trace_details
+
+This is usually undef, but occasionally has a string that overrides the
+file/line number debugging a trace usually provides on test failure.
+
+=item $undef_or_string = $event->trace_package
+
+Same as C<(caller())[0]>, the first element of the trace frame.
+
+Will be undef if not present.
+
+=item $undef_or_string = $event->trace_file
+
+Same as C<(caller())[1]>, the second element of the trace frame.
+
+Will be undef if not present.
+
+=item $undef_or_integer = $event->trace_line
+
+Same as C<(caller())[2]>, the third element of the trace frame.
+
+Will be undef if not present.
+
+=item $undef_or_string = $event->trace_subname
+
+=item $undef_or_string = $event->trace_tool
+
+Aliases for the same thing
+
+Same as C<(caller($level))[4]>, the fourth element of the trace frame.
+
+Will be undef if not present.
+
+=item $undef_or_string = $event->trace_signature
+
+A string that is a unique signature for the trace. If a single context
+generates multiple events they will all have the same signature. This can be
+used to tie assertions and diagnostics sent as seperate events together after
+the fact.
+
+=back
+
+=head2 ASSERT FACET
+
+=over 4
+
+=item $bool = $event->has_assert
+
+Returns true if the event has an assert facet, false if it does not.
+
+=item $undef_or_hashref = $event->the_assert
+
+Returns the assert facet if present, undef if it is not.
+
+=item @list_of_facets = $event->assert
+
+TODO
+
+=item EMPTY_LIST_OR_STRING = $event->assert_brief
+
+Returns a string giving a brief of the assertion if an assertion is present.
+Returns an empty list if no assertion is present.
+
+=back
+
+=head2 SUBTESTS (PARENT FACET)
+
+=over 4
+
+=item $bool = $event->has_subtest
+
+True if a subetest is present in this event.
+
+=item $undef_or_hashref = $event->the_subtest
+
+Get the one subtest if present, otherwise undef.
+
+=item @list_of_facets = $event->subtest
+
+TODO
+
+=item EMPTY_LIST_OR_OBJECT = $event->subtest_result
+
+Returns an empty list if there is no subtest.
+
+Get an instance of L<Test2::API::InterceptResult> representing the subtest.
+
+=back
+
+=head2 CONTROL FACET (BAILOUT, ENCODING)
+
+=over 4
+
+=item $bool = $event->has_bailout
+
+True if there was a bailout
+
+=item $undef_hashref = $event->the_bailout
+
+Return the control facet if it requested a bailout.
+
+=item EMPTY_LIST_OR_HASHREF = $event->bailout
+
+Get a list of 0 or 1 hashrefs. The hashref will be the control facet if a
+bail-out was requested.
+
+=item EMPTY_LIST_OR_STRING = $event->bailout_brief
+
+Get the brief of the balout if present.
+
+=item EMPTY_LIST_OR_STRING = $event->bailout_reason
+
+Get the reason for the bailout, an empty string if no reason was provided, or
+an empty list if there was no bailout.
+
+=back
+
+=head2 PLAN FACET
+
+TODO
+
+=over 4
+
+=item $bool = $event->has_plan
+
+=item $undef_or_hashref = $event->the_plan
+
+=item @list_if_hashrefs = $event->plan
+
+=item EMPTY_LIST_OR_STRING $event->plan_brief
+
+=back
+
+=head2 AMNESTY FACET (TODO AND SKIP)
+
+TODO
+
+=over 4
+
+=item $event->has_amnesty
+
+=item $event->the_amnesty
+
+=item $event->amnesty
+
+=item $event->amnesty_reasons
+
+=item $event->has_todos
+
+=item $event->todos
+
+=item $event->todo_reasons
+
+=item $event->has_skips
+
+=item $event->skips
+
+=item $event->skip_reasons
+
+=item $event->has_other_amnesty
+
+=item $event->other_amnesty
+
+=item $event->other_amnesty_reasons
+
+=back
+
+=head2 ERROR FACET (CAPTURED EXCEPTIONS)
+
+TODO
+
+=over 4
+
+=item $event->has_errors
+
+=item $event->the_errors
+
+=item $event->errors
+
+=item $event->error_messages
+
+=item $event->error_brief
+
+=back
+
+=head2 INFO FACET (DIAG, NOTE)
+
+TODO
+
+=over 4
+
+=item $event->has_info
+
+=item $event->the_info
+
+=item $event->info
+
+=item $event->info_messages
+
+=item $event->has_diags
+
+=item $event->diags
+
+=item $event->diag_messages
+
+=item $event->has_notes
+
+=item $event->notes
+
+=item $event->note_messages
+
+=item $event->has_other_info
+
+=item $event->other_info
+
+=item $event->other_info_messages
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<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
diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm
new file mode 100644 (file)
index 0000000..5964037
--- /dev/null
@@ -0,0 +1,25 @@
+package Test2::API::InterceptResult::Facet;
+use strict;
+use warnings;
+
+our $VERSION = '1.302181';
+
+BEGIN {
+    require Test2::EventFacet;
+    our @ISA = ('Test2::EventFacet');
+}
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+    my $self = shift;
+
+    my $name = $AUTOLOAD;
+    $name =~ s/^.*:://g;
+
+    return undef unless exists $self->{$name};
+    return $self->{$name};
+}
+
+sub DESTROY {}
+
+1;
diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm
new file mode 100644 (file)
index 0000000..a703096
--- /dev/null
@@ -0,0 +1,66 @@
+package Test2::API::InterceptResult::Hub;
+use strict;
+use warnings;
+
+our $VERSION = '1.302181';
+
+BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
+use Test2::Util::HashBase;
+
+sub init {
+    my $self = shift;
+    $self->SUPER::init();
+    $self->{+NESTED} = 0;
+}
+
+sub inherit {
+    my $self = shift;
+
+    $self->{+NESTED} = 0;
+}
+
+sub terminate { }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::InterceptResult::Hub - Hub used by InterceptResult.
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<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
diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm
new file mode 100644 (file)
index 0000000..c4de89c
--- /dev/null
@@ -0,0 +1,196 @@
+package Test2::API::InterceptResult::Squasher;
+use strict;
+use warnings;
+
+our $VERSION = '1.302181';
+
+use Carp qw/croak/;
+use List::Util qw/first/;
+
+use Test2::Util::HashBase qw{
+    <events
+
+    +down_sig +down_buffer
+
+    +up_into +up_sig +up_clear
+};
+
+sub init {
+    my $self = shift;
+
+    croak "'events' is a required attribute"  unless $self->{+EVENTS};
+}
+
+sub can_squash {
+    my $self = shift;
+    my ($event) = @_;
+
+    # No info, no squash
+    return unless $event->has_info;
+
+    # Do not merge up if one of these is true
+    return if first { $event->$_ } qw/causes_fail has_assert has_bailout has_errors has_plan has_subtest/;
+
+    # Signature if we can squash
+    return $event->trace_signature;
+}
+
+sub process {
+    my $self = shift;
+    my ($event) = @_;
+
+    return if $self->squash_up($event);
+    return if $self->squash_down($event);
+
+    $self->flush_down($event);
+
+    push @{$self->{+EVENTS}} => $event;
+
+    return;
+}
+
+sub squash_down {
+    my $self = shift;
+    my ($event) = @_;
+
+    my $sig = $self->can_squash($event)
+        or return;
+
+    $self->flush_down()
+        if $self->{+DOWN_SIG} && $self->{+DOWN_SIG} ne $sig;
+
+    $self->{+DOWN_SIG} ||= $sig;
+    push @{$self->{+DOWN_BUFFER}} => $event;
+
+    return 1;
+}
+
+sub flush_down {
+    my $self = shift;
+    my ($into) = @_;
+
+    my $sig    = delete $self->{+DOWN_SIG};
+    my $buffer = delete $self->{+DOWN_BUFFER};
+
+    return unless $buffer && @$buffer;
+
+    my $fsig = $into ? $into->trace_signature : undef;
+
+    if ($fsig && $fsig eq $sig) {
+        $self->squash($into, @$buffer);
+    }
+    else {
+        push @{$self->{+EVENTS}} => @$buffer if $buffer;
+    }
+}
+
+sub clear_up {
+    my $self = shift;
+
+    return unless $self->{+UP_CLEAR};
+
+    delete $self->{+UP_INTO};
+    delete $self->{+UP_SIG};
+    delete $self->{+UP_CLEAR};
+}
+
+sub squash_up {
+    my $self = shift;
+    my ($event) = @_;
+    no warnings 'uninitialized';
+
+    $self->clear_up;
+
+    if ($event->has_assert) {
+        if(my $sig = $event->trace_signature) {
+            $self->{+UP_INTO}  = $event;
+            $self->{+UP_SIG}   = $sig;
+            $self->{+UP_CLEAR} = 0;
+        }
+        else {
+            $self->{+UP_CLEAR} = 1;
+            $self->clear_up;
+        }
+
+        return;
+    }
+
+    my $into = $self->{+UP_INTO} or return;
+
+    # Next iteration should clear unless something below changes that
+    $self->{+UP_CLEAR} = 1;
+
+    # Only merge into matching trace signatres
+    my $sig = $self->can_squash($event);
+    return unless $sig eq $self->{+UP_SIG};
+
+    # OK Merge! Do not clear merge in case the return event is also a matching sig diag-only
+    $self->{+UP_CLEAR} = 0;
+
+    $self->squash($into, $event);
+
+    return 1;
+}
+
+sub squash {
+    my $self = shift;
+    my ($into, @from) = @_;
+    push @{$into->facet_data->{info}} => $_->info for @from;
+}
+
+sub DESTROY {
+    my $self = shift;
+
+    return unless $self->{+EVENTS};
+    $self->flush_down();
+    return;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::InterceptResult::Squasher - Encapsulation of the algorithm that
+squashes diags into assertions.
+
+=head1 DESCRIPTION
+
+Internal use only, please ignore.
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<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
index d6b6e85..272a027 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Stack;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Test2::Hub();
@@ -216,7 +216,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index e1c567a..e84fd06 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Scalar::Util qw/blessed reftype/;
 use Carp qw/croak/;
@@ -768,7 +768,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 076ac97..f6c0135 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Bail;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -99,7 +99,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 9fa732f..43f26f2 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Diag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -89,7 +89,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 3fb7364..1be7d12 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Encoding;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Carp qw/croak/;
 
@@ -87,7 +87,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index df83ac8..93ec0d0 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Exception;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -103,7 +103,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index f09a035..1b80ec4 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Fail;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Test2::EventFacet::Info;
 
@@ -108,7 +108,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index ef08124..b7c124b 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use Carp qw/croak/;
 use Scalar::Util qw/reftype/;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
 use Test2::Util::HashBase;
@@ -270,7 +270,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 4a310f3..f15f144 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Note;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -87,7 +87,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 088c8b6..61d5a0a 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Ok;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -69,7 +69,14 @@ sub facet_data {
     };
 
     if (my @exra_amnesty = $self->extra_amnesty) {
-        unshift @{$out->{amnesty}} => @exra_amnesty;
+        my %seen;
+
+        # It is possible the extra amnesty can be a duplicate, so filter it.
+        $out->{amnesty} = [
+            grep { !$seen{defined($_->{tag}) ? $_->{tag} : ''}->{defined($_->{details}) ? $_->{details} : ''}++ }
+                @exra_amnesty,
+                @{$out->{amnesty}},
+        ];
     }
 
     return $out;
@@ -152,7 +159,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index bfc3a73..a01ebd9 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Pass;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Test2::EventFacet::Info;
 
@@ -104,7 +104,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index ad8f927..3cdd104 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Plan;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -159,7 +159,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index a992324..3452490 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Skip;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
@@ -117,7 +117,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index aed0c00..c95c516 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
 use Test2::Util::HashBase qw{subevents buffered subtest_id subtest_uuid};
@@ -150,7 +150,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index b3cb1d8..d8679d9 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::TAP::Version;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Carp qw/croak/;
 
@@ -91,7 +91,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 326a818..c621625 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::V2;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Scalar::Util qw/reftype/;
 use Carp qw/croak/;
@@ -33,7 +33,8 @@ sub init {
 
         $self->{+ABOUT}->{uuid} = $uuid;
     }
-    elsif ($uuid = $self->{+ABOUT}->{uuid}) {
+    elsif ($self->{+ABOUT} && $self->{+ABOUT}->{uuid}) {
+        $uuid = $self->{+ABOUT}->{uuid};
         $self->SUPER::set_uuid($uuid);
     }
 
@@ -228,7 +229,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index dbd1448..ce28a85 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Waiting;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
@@ -66,7 +66,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 13c217f..84910af 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Test2::Util::HashBase qw/-details/;
 use Carp qw/croak/;
@@ -83,7 +83,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index f12ebf8..1d99b54 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::About;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -package -no_display -uuid -eid };
@@ -82,7 +82,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 45ed927..ef84ab4 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Amnesty;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 sub is_list { 1 }
 
@@ -81,7 +81,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 02f89af..62611b6 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Assert;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -pass -no_debug -number };
@@ -83,7 +83,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 8a04a4a..eb083d9 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Control;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -global -terminate -halt -has_callback -encoding -phase };
@@ -97,7 +97,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 87baf11..0e47cf2 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Error;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 sub facet_key { 'errors' }
 sub is_list { 1 }
@@ -83,7 +83,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 3701425..572c048 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Hub;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 sub is_list { 1 }
 sub facet_key { 'hubs' }
@@ -99,7 +99,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index badd2d0..b474596 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Info;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 sub is_list { 1 }
 
@@ -122,7 +122,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 0c127b5..2326b66 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Info::Table;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Carp qw/confess/;
 
@@ -134,7 +134,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 2b75764..af065ca 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Meta;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use vars qw/$AUTOLOAD/;
@@ -94,7 +94,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index ac26737..35dda12 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Parent;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Carp qw/confess/;
 
@@ -88,7 +88,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 355588b..45f96c9 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Plan;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -count -skip -none };
@@ -84,7 +84,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 13fe4cb..4afb364 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Render;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 sub is_list { 1 }
 
@@ -96,7 +96,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 455b0ee..3fa9346 100644 (file)
@@ -2,14 +2,14 @@ package Test2::EventFacet::Trace;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 
 use Test2::Util qw/get_tid pkg_to_file gen_uid/;
 use Carp qw/confess/;
 
-use Test2::Util::HashBase qw{^frame ^pid ^tid ^cid -hid -nested details -buffered -uuid -huuid};
+use Test2::Util::HashBase qw{^frame ^pid ^tid ^cid -hid -nested details -buffered -uuid -huuid <full_caller};
 
 {
     no warnings 'once';
@@ -70,11 +70,15 @@ sub throw {
 
 sub call { @{$_[0]->{+FRAME}} }
 
+sub full_call { @{$_[0]->{+FULL_CALLER}} }
+
 sub package { $_[0]->{+FRAME}->[0] }
 sub file    { $_[0]->{+FRAME}->[1] }
 sub line    { $_[0]->{+FRAME}->[2] }
 sub subname { $_[0]->{+FRAME}->[3] }
 
+sub warning_bits { $_[0]->{+FULL_CALLER} ? $_[0]->{+FULL_CALLER}->[9] : undef }
+
 1;
 
 __END__
@@ -118,6 +122,8 @@ C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
 
 Get the call frame arrayref.
 
+    [$package, $file, $line, $subname]
+
 =item $int = $trace->{pid}
 
 =item $int = $trace->pid()
@@ -143,6 +149,27 @@ The ID of the context that was used to create the event.
 The UUID of the context that was used to create the event. (If uuid tagging was
 enabled)
 
+=item ($pkg, $file, $line, $subname) = $trace->call
+
+Get the basic call info as a list.
+
+=item @caller = $trace->full_call
+
+Get the full caller(N) results.
+
+=item $warning_bits = $trace->warning_bits
+
+Get index 9 from the full caller info. This is the warnings_bits field.
+
+The value of this is not portable across perl versions or even processes.
+However it can be used in the process that generated it to reproduce the
+warnings settings in a new scope.
+
+    eval <<EOT;
+    BEGIN { ${^WARNING_BITS} = $trace->warning_bits };
+    ... context's warning settings apply here ...
+    EOT
+
 =back
 
 =head2 DISCOURAGED HUB RELATED FIELDS
@@ -269,7 +296,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 17c28bf..cc4bf93 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 my %ADDED;
@@ -148,7 +148,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 120c82d..99fccb8 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Formatter::TAP;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Test2::Util qw/clone_io/;
 
@@ -518,7 +518,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index e041f6d..efa521b 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Carp qw/carp croak confess/;
@@ -351,7 +351,7 @@ sub process {
     $self->{+FAILED}++ if $fail && $f->{assert};
     $self->{+_PASSING} = 0 if $fail;
 
-    my $code = $f->{control}->{terminate};
+    my $code = $f->{control} ? $f->{control}->{terminate} : undef;
     my $count = $self->{+COUNT};
 
     if (my $plan = $f->{plan}) {
@@ -368,7 +368,7 @@ sub process {
         }
     }
 
-    $e->callback($self) if $f->{control}->{has_callback};
+    $e->callback($self) if $f->{control} && $f->{control}->{has_callback};
 
     $self->{+_FORMATTER}->write($e, $count, $f) if $self->{+_FORMATTER};
 
@@ -376,7 +376,7 @@ sub process {
         $_->{code}->($self, $e, $count, $f) for @{$self->{+_LISTENERS}};
     }
 
-    if ($f->{control}->{halt}) {
+    if ($f->{control} && $f->{control}->{halt}) {
         $code ||= 255;
         $self->set_bailed_out($e);
     }
@@ -899,7 +899,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 317dfa8..2358a0b 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Test2::Hub::Interceptor::Terminator();
@@ -27,6 +27,62 @@ sub inherit {
         $self->{+IPC} = $ipc;
         $ipc->add_hub($self->{+HID});
     }
+
+    if (my $ls = $from->{+_LISTENERS}) {
+        push @{$self->{+_LISTENERS}} => grep { $_->{intercept_inherit} } @$ls;
+    }
+
+    if (my $pfs = $from->{+_PRE_FILTERS}) {
+        push @{$self->{+_PRE_FILTERS}} => grep { $_->{intercept_inherit} } @$pfs;
+    }
+
+    if (my $fs = $from->{+_FILTERS}) {
+        push @{$self->{+_FILTERS}} => grep { $_->{intercept_inherit} } @$fs;
+    }
+}
+
+sub clean_inherited {
+    my $self = shift;
+    my %params = @_;
+
+    my @sets = (
+        $self->{+_LISTENERS},
+        $self->{+_PRE_FILTERS},
+        $self->{+_FILTERS},
+    );
+
+    for my $set (@sets) {
+        next unless $set;
+
+        for my $i (@$set) {
+            my $cbs = $i->{intercept_inherit} or next;
+            next unless ref($cbs) eq 'HASH';
+            my $cb = $cbs->{clean} or next;
+            $cb->(%params);
+        }
+    }
+}
+
+sub restore_inherited {
+    my $self = shift;
+    my %params = @_;
+
+    my @sets = (
+        $self->{+_FILTERS},
+        $self->{+_PRE_FILTERS},
+        $self->{+_LISTENERS},
+    );
+
+    for my $set (@sets) {
+        next unless $set;
+
+        for my $i (@$set) {
+            my $cbs = $i->{intercept_inherit} or next;
+            next unless ref($cbs) eq 'HASH';
+            my $cb = $cbs->{restore} or next;
+            $cb->(%params);
+        }
+    }
 }
 
 sub terminate {
@@ -78,7 +134,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 906e7b0..e89796f 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 1;
@@ -41,7 +41,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index acc6369..73dbfd6 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
 use Test2::Util::HashBase qw/nested exit_code manual_skip_all/;
@@ -126,7 +126,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index e9d29cc..9ddd33c 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Test2::API::Instance;
@@ -150,7 +150,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index db6642a..2ca2fa8 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC::Driver;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Carp qw/confess/;
@@ -277,7 +277,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 09fdd5c..421b9c1 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC::Driver::Files;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
 
@@ -181,10 +181,10 @@ do so if Test::Builder is loaded for legacy reasons.
 
     # Write and rename the file.
     my ($ren_ok, $ren_err);
-    my ($ok, $err) = try_sig_mask {
+    my ($ok, $err) = try_sig_mask(sub {
         Storable::store($e, $file);
         ($ren_ok, $ren_err) = do_rename("$file", $ready);
-    };
+    });
 
     if ($ok) {
         $self->abort("Could not rename file '$file' -> '$ready': $ren_err") unless $ren_ok;
@@ -493,7 +493,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 5139e46..59f6eef 100644 (file)
@@ -16,7 +16,7 @@ use Test2::API qw/context run_subtest test2_stack/;
 use Test2::Hub::Interceptor();
 use Test2::Hub::Interceptor::Terminator();
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 BEGIN { require Exporter; our @ISA = qw(Exporter) }
 our @EXPORT = qw{
@@ -425,7 +425,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 07811f0..a1b02c9 100644 (file)
@@ -502,7 +502,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 0ba4995..4b297c7 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use POSIX();
 use Config qw/%Config/;
@@ -438,7 +438,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 90345d0..45f6ca6 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 
 use Carp qw/croak/;
@@ -172,7 +172,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index 4bcee18..2afaea7 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::Facets2Legacy;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use Carp qw/croak confess/;
 use Scalar::Util qw/blessed/;
@@ -289,7 +289,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index a6a04f9..9047698 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::HashBase;
 use strict;
 use warnings;
 
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 #################################################################
 #                                                               #
index 33b3648..b61c23b 100644 (file)
@@ -1,8 +1,12 @@
 package Test2::Util::Trace;
 require Test2::EventFacet::Trace;
-@ISA = ('Test2::EventFacet::Trace');
 
-our $VERSION = '1.302175';
+use warnings;
+use strict;
+
+our @ISA = ('Test2::EventFacet::Trace');
+
+our $VERSION = '1.302181';
 
 1;
 
@@ -44,7 +48,7 @@ F<http://github.com/Test-More/test-more/>.
 
 =head1 COPYRIGHT
 
-Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index f3b394d..99b32e0 100644 (file)
@@ -1,5 +1,5 @@
 package ok;
-our $VERSION = '1.302175';
+our $VERSION = '1.302181';
 
 use strict;
 use Test::More ();
index edd201c..b8979c6 100644 (file)
@@ -3,8 +3,11 @@
 # Dave Rolsky found a bug where if current_test() is used and no
 # tests are run via Test::Builder it will blow up.
 
+use strict;
+use warnings;
+
 use Test::Builder;
-$TB = Test::Builder->new;
+my $TB = Test::Builder->new;
 $TB->plan(tests => 2);
 print "ok 1\n";
 print "ok 2\n";
diff --git a/cpan/Test-Simple/t/Legacy/Regression/870-experimental-warnings.t b/cpan/Test-Simple/t/Legacy/Regression/870-experimental-warnings.t
new file mode 100644 (file)
index 0000000..9758d24
--- /dev/null
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use Test2::Tools::Tiny;
+
+BEGIN { skip_all "Only testing on 5.18+" if $] < 5.018 }
+
+require Test::More;
+*cmp_ok = \&Test::More::cmp_ok;
+
+no warnings "experimental::smartmatch";
+
+my $warnings = warnings { cmp_ok(1, "~~", 1) };
+
+ok(!@$warnings, "Did not get any warnings");
+
+done_testing;
index 1e7b6c9..4829109 100644 (file)
@@ -1,6 +1,9 @@
 #!/usr/bin/perl
 # HARNESS-NO-STREAM
 
+use strict;
+use warnings;
+
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
@@ -16,7 +19,7 @@ my $T = Test::Builder->new;
 $T->no_ending(1);
 
 for my $num (1..10) {
-    $tnum = $num * 2;
+    my $tnum = $num * 2;
     pass("I'm ok");
     $T->current_test($tnum);
     print "ok $tnum - You're ok\n";
index 4ec99ae..02f9539 100644 (file)
@@ -16,6 +16,7 @@ BEGIN {
 # This tests against that.
 
 use strict;
+use warnings;
 
 
 # Can't use Test.pm, that's a 5.005 thing.
@@ -58,14 +59,14 @@ ERR
 }
 
 {
-    # line 62
+    # line 63
     like("foo", "not a regex");
     $TB->is_eq($out->read, <<OUT);
 not ok 2
 OUT
 
     $TB->is_eq($err->read, <<OUT);
-#   Failed test at $0 line 62.
+#   Failed test at $0 line 63.
 #     'not a regex' doesn't look much like a regex to me.
 OUT
 
index 21efe87..c43b3a2 100644 (file)
@@ -11,6 +11,7 @@ BEGIN {
 }
 
 use strict;
+use warnings;
 
 use Test::Builder;
 require Test::Simple::Catch;
index 7d28846..c5e5a23 100644 (file)
@@ -9,10 +9,13 @@ BEGIN {
 
 use Test::More;
 
+use strict;
+use warnings;
+
 plan tests => 36;
 
 
-$Why = 'Just testing the todo interface.';
+my $Why = 'Just testing the todo interface.';
 
 my $is_todo;
 TODO: {
diff --git a/cpan/Test-Simple/t/Test2/modules/API/InterceptResult.t b/cpan/Test-Simple/t/Test2/modules/API/InterceptResult.t
new file mode 100644 (file)
index 0000000..4e9628f
--- /dev/null
@@ -0,0 +1,302 @@
+use strict;
+use warnings;
+
+use Test::Builder;
+use Test2::Tools::Tiny;
+use Test2::API::InterceptResult;
+use Scalar::Util qw/reftype/;
+use Test2::API qw/intercept context/;
+
+my $CLASS = 'Test2::API::InterceptResult';
+
+tests construction => sub {
+    my $one = $CLASS->new('a');
+    ok($one->isa($CLASS), "Got an instance");
+    is(reftype($one), 'ARRAY', "Blessed arrayref");
+    is_deeply($one, ['a'], "Ref looks good.");
+
+    my $two = $CLASS->new_from_ref(['a']);
+    ok($two->isa($CLASS), "Got an instance");
+    is(reftype($two), 'ARRAY', "Blessed arrayref");
+    is_deeply($two, ['a'], "Ref looks good.");
+
+    my $three = $two->clone;
+    ok($three->isa($CLASS), "Got an instance");
+    is(reftype($three), 'ARRAY', "Blessed arrayref");
+    is_deeply($three, ['a'], "Ref looks good.");
+
+    push @$two => 'b';
+    is_deeply($two, ['a', 'b'], "Modified two");
+    is_deeply($three, ['a'], "three was not changed");
+
+    my $four = intercept {
+        ok(1, "Pass");
+    };
+
+    ok($four->isa($CLASS), "Intercept returns an instance");
+};
+
+tests event_list => sub {
+    my $one = $CLASS->new('a', 'b');
+    is_deeply([$one->event_list], ['a', 'b'], "event_list is essentially \@{\$self}");
+};
+
+tests _upgrade => sub {
+    require Test2::Event::Pass;
+    my $event = Test2::Event::Pass->new(name => 'soup for you', trace => {frame => ['foo', 'foo.pl', 42]});
+    ok($event->isa('Test2::Event'), "Start with an event");
+
+    my $one = $CLASS->new;
+    my $up = $one->_upgrade($event);
+    ok($up->isa('Test2::API::InterceptResult::Event'), "Upgraded the event");
+    is($up->result_class, $CLASS, "set the result class");
+
+    is_deeply($event->facet_data, $up->facet_data, "Facet data is identical");
+
+    $up->facet_data->{trace}->{frame}->[2] = 43;
+    is($up->trace_line, 43, "Modified the facet data in the upgraded clone");
+    is($event->facet_data->{trace}->{frame}->[2], 42, "Did nto modify the original");
+
+    my $up2 = $one->_upgrade($up);
+    is("$up2", "$up", "Returned the ref unmodified because it is already an upgraded item");
+
+    require Test2::Event::V2;
+    my $subtest = 'Test2::Event::V2'->new(
+        trace => {frame => ['foo', 'foo.pl', 42]},
+        assert => {pass => 1, details => 'pass'},
+        parent => {
+            hid => 1,
+            children => [ $event ],
+        },
+    );
+
+    my $subup = $one->_upgrade($subtest);
+    ok($subup->the_subtest->{children}->isa($CLASS), "Blessed subtest subevents");
+    ok(
+        $subup->the_subtest->{children}->[0]->isa('Test2::API::InterceptResult::Event'),
+        "Upgraded the children"
+    );
+};
+
+tests hub => sub {
+    my $one = intercept {
+        ok(1, "pass");
+        ok(0, "fail");
+        plan 2;
+    };
+
+    my $hub = $one->hub;
+    ok($hub->isa('Test2::Hub'), "Hub is a proper instance");
+    ok($hub->check_plan, "Had a plan and followed it");
+    is($hub->count, 2, "saw both events");
+    is($hub->failed, 1, "saw a failure");
+    ok($hub->ended, "Hub ended");
+
+    is_deeply(
+        $one->state,
+        {
+            count => 2,
+            failed => 1,
+            is_passing => 0,
+            plan => 2,
+            bailed_out => undef,
+            skip_reason => undef,
+            follows_plan => 1,
+        },
+        "Got the hub state"
+    );
+};
+
+tests upgrade => sub {
+    my $one = intercept {
+        require Test::More;
+        Test::More::ok(1, "pass");
+        Test::More::ok(1, "pass");
+    };
+
+    ok($one->[0]->isa('Test2::Event::Ok'), "Original event is not upgraded 0");
+    ok($one->[1]->isa('Test2::Event::Ok'), "Original event is not upgraded 1");
+
+    my $two = $one->upgrade;
+    ok($one->[0]->isa('Test2::Event::Ok'), "Did not modify original 0");
+    ok($one->[0]->isa('Test2::Event::Ok'), "Did not modify original 1");
+    ok($two->[0]->isa('Test2::API::InterceptResult::Event'), "Upgraded copy 0");
+    ok($two->[1]->isa('Test2::API::InterceptResult::Event'), "Upgraded copy 1");
+
+    my $three = $two->upgrade;
+    ok("$two->[0]" ne "$three->[0]", "Upgrade on an already upgraded instance returns copies of the events, not originals");
+
+    like(
+        exception { $one->upgrade() },
+        qr/Called a method that creates a new instance in void context/,
+        "Calling upgrade() without keeping the result is a bug"
+    );
+
+    $one->upgrade(in_place => 1);
+    ok($one->[0]->isa('Test2::API::InterceptResult::Event'), "Upgraded in place 0");
+    ok($one->[1]->isa('Test2::API::InterceptResult::Event'), "Upgraded in place 1");
+};
+
+tests squash_info => sub {
+    my $one = intercept {
+        diag "isolated 1";
+        note "isolated 2";
+        sub {
+            my $ctx = context();
+            diag "inline 1";
+            note "inline 2";
+            $ctx->fail;
+            diag "inline 3";
+            note "inline 4";
+            $ctx->release;
+        }->();
+        diag "isolated 3";
+        note "isolated 4";
+    };
+
+    my $new = $one->squash_info;
+    $one->squash_info(in_place => 1);
+    is_deeply(
+        $new,
+        $one,
+        "Squash and squash in place produce the same result"
+    );
+
+    is(@$one, 5, "5 events after squash");
+    is_deeply([$one->[0]->info_messages], ['isolated 1'], "First event not modified");
+    is_deeply([$one->[1]->info_messages], ['isolated 2'], "Second event not modified");
+    is_deeply([$one->[3]->info_messages], ['isolated 3'], "second to last event not modified");
+    is_deeply([$one->[4]->info_messages], ['isolated 4'], "last event not modified");
+    is_deeply(
+        [$one->[2]->info_messages],
+        [
+            'inline 1',
+            'inline 2',
+            'inline 3',
+            'inline 4',
+        ],
+        "Assertion collected info generated in the same context"
+    );
+    ok($one->[2]->has_assert, "Assertion is still an assertion");
+
+
+    my $two = intercept {
+
+    };
+};
+
+tests messages => sub {
+    my $one = intercept {
+        note "foo";
+        diag "bar";
+
+        ok(1);
+
+        sub {
+            my $ctx = context();
+
+            $ctx->send_ev2(
+                errors => [
+                    {tag => 'error', details => "Error 1" },
+                    {tag => 'error', details => "Error 2" },
+                ],
+                info => [
+                    {tag => 'DIAG', details => 'Diag 1'},
+                    {tag => 'DIAG', details => 'Diag 2'},
+                    {tag => 'NOTE', details => 'Note 1'},
+                    {tag => 'NOTE', details => 'Note 2'},
+                ],
+            );
+
+            $ctx->release;
+        }->();
+
+        note "baz";
+        diag "bat";
+    };
+
+    is_deeply(
+        $one->diag_messages,
+        ['bar', 'Diag 1', 'Diag 2', 'bat'],
+        "Got diags"
+    );
+
+    is_deeply(
+        $one->note_messages,
+        ['foo', 'Note 1', 'Note 2', 'baz'],
+        "Got Notes"
+    );
+
+    is_deeply(
+        $one->error_messages,
+        ['Error 1', 'Error 2'],
+        "Got errors"
+    );
+};
+
+tests grep => sub {
+    my $one = intercept {
+        ok(1),                          # 0
+        note "A Note";                  # 1
+        diag "A Diag";                  # 2
+        tests foo => sub { ok(1) };   # 3
+
+        sub {                           # 4
+            my $ctx = context();
+            $ctx->send_ev2(errors => [{tag => 'error', details => "Error 1"}]);
+            $ctx->release;
+        }->();                          # 4
+
+        plan 2;                         # 5
+    };
+
+    $one->upgrade(in_place => 1);
+
+    is_deeply($one->asserts, [$one->[0], $one->[3]], "Got the asserts");
+    is_deeply($one->subtests, [$one->[3]], "Got the subtests");
+    is_deeply($one->diags, [$one->[2]], "Got the diags");
+    is_deeply($one->notes, [$one->[1]], "Got the notes");
+    is_deeply($one->errors, [$one->[4]], "Got the errors");
+    is_deeply($one->plans, [$one->[5]], "Got the plans");
+
+    $one->asserts(in_place => 1);
+    is(@$one, 2, "2 events");
+    ok($_->has_assert, "Is an assert") for @$one;
+};
+
+tests map => sub {
+    my $one = intercept { ok(1); ok(2) };
+    $one->upgrade(in_place => 1);
+
+    is_deeply(
+        $one->flatten,
+        [ $one->[0]->flatten, $one->[1]->flatten ],
+        "Flattened both events"
+    );
+
+    is_deeply(
+        $one->briefs,
+        [ $one->[0]->brief, $one->[1]->brief ],
+        "Brief of both events"
+    );
+
+    is_deeply(
+        $one->summaries,
+        [ $one->[0]->summary, $one->[1]->summary ],
+        "Summaries of both events"
+    );
+
+    my $two = intercept {
+        tests foo => sub { ok(1) };
+        ok(1);
+        tests bar => sub { ok(1) };
+    }->upgrade;
+
+    is_deeply(
+        $two->subtest_results,
+        [ $two->[0]->subtest_result, $two->[2]->subtest_result ],
+        "Got subtest results"
+    );
+};
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Event.t b/cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Event.t
new file mode 100644 (file)
index 0000000..e1b2716
--- /dev/null
@@ -0,0 +1,950 @@
+use strict;
+use warnings;
+
+use Test2::Tools::Tiny;
+use Test2::API::InterceptResult::Event;
+
+my $CLASS = 'Test2::API::InterceptResult::Event';
+
+tests facet_map => sub {
+    ok(!$CLASS->can('plugins'), "Did not expose 'plugins' sub");
+
+    my $fm = $CLASS->facet_map;
+
+    is_deeply($fm->{__GENERIC__}, {class => 'Test2::API::InterceptResult::Facet', loaded => 1}, "Generic '__GENERIC__'");
+
+    is_deeply($CLASS->facet_info('about'),   {class => 'Test2::EventFacet::About',   list => 0, loaded => 1}, "Found 'about' facet");
+    is_deeply($CLASS->facet_info('amnesty'), {class => 'Test2::EventFacet::Amnesty', list => 1, loaded => 1}, "Found 'amnesty' facet");
+    is_deeply($CLASS->facet_info('assert'),  {class => 'Test2::EventFacet::Assert',  list => 0, loaded => 1}, "Found 'assert' facet");
+    is_deeply($CLASS->facet_info('control'), {class => 'Test2::EventFacet::Control', list => 0, loaded => 1}, "Found 'control' facet");
+    is_deeply($CLASS->facet_info('errors'),  {class => 'Test2::EventFacet::Error',   list => 1, loaded => 1}, "Found 'errors' facet");
+    is_deeply($CLASS->facet_info('hubs'),    {class => 'Test2::EventFacet::Hub',     list => 1, loaded => 1}, "Found 'hubs' facet");
+    is_deeply($CLASS->facet_info('info'),    {class => 'Test2::EventFacet::Info',    list => 1, loaded => 1}, "Found 'info' facet");
+    is_deeply($CLASS->facet_info('meta'),    {class => 'Test2::EventFacet::Meta',    list => 0, loaded => 1}, "Found 'meta' facet");
+    is_deeply($CLASS->facet_info('parent'),  {class => 'Test2::EventFacet::Parent',  list => 0, loaded => 1}, "Found 'parent' facet");
+    is_deeply($CLASS->facet_info('plan'),    {class => 'Test2::EventFacet::Plan',    list => 0, loaded => 1}, "Found 'plan' facet");
+    is_deeply($CLASS->facet_info('render'),  {class => 'Test2::EventFacet::Render',  list => 1, loaded => 1}, "Found 'render' facet");
+    is_deeply($CLASS->facet_info('trace'),   {class => 'Test2::EventFacet::Trace',   list => 0, loaded => 1}, "Found 'trace' facet");
+};
+
+tests init => sub {
+    # This is just here to make sure the later test is meaningful. If this
+    # starts to fail it probably means this test needs to be changed.
+    ok(!$INC{'Test2/API/InterceptResult.pm'}, "Did not load result class yes");
+    my $one = $CLASS->new();
+    ok($one->isa($CLASS), "Got an instance");
+    is_deeply($one->facet_data, {}, "Got empty data");
+    is($one->result_class, 'Test2::API::InterceptResult', "Got default result class");
+    ok($INC{'Test2/API/InterceptResult.pm'}, "Loaded result class");
+
+    like(
+        exception { $CLASS->new(facet_data => {assert => [{}]}) },
+        qr/^Facet 'assert' is an only-one facet, but got 'ARRAY' instead of a hashref/,
+        "Check list vs non-list when we can (check for single)"
+    );
+
+    like(
+        exception { $CLASS->new(facet_data => {info => {}}) },
+        qr/^Facet 'info' is a list facet, but got 'HASH' instead of an arrayref/,
+        "Check list vs non-list when we can (check for list)"
+    );
+
+    like(
+        exception { $CLASS->new(facet_data => {info => [{},[]]}) },
+        qr/Got item type 'ARRAY' in list-facet 'info', all items must be hashrefs/,
+        "Check each item in a list facet is a hashref"
+    );
+
+    my $two = $CLASS->new(facet_data => {assert => {}, info => [{}]});
+    ok($two->isa($CLASS), "Got an instance with some actual facets");
+};
+
+tests facet => sub {
+    my $one = $CLASS->new(facet_data => {
+        other_single => {},
+        other_list   => [{}],
+        assert => {pass => 1, details => 'xxx'},
+        info => [
+            {tag => 'DIAG', details => 'xxx'},
+            {tag => 'NOTE', details => 'xxx'},
+        ],
+    });
+
+    ok(($one->facet('assert'))[0]->isa('Test2::EventFacet::Assert'),                "Bless the assert facet");
+    ok(($one->facet('other_list'))[0]->isa('Test2::EventFacet'),                    "Bless the other_list as generic");
+    ok(($one->facet('other_single'))[0]->isa('Test2::EventFacet'),                  "Bless the other_single as generic");
+    ok(($one->facet('other_list'))[0]->isa('Test2::API::InterceptResult::Facet'),   "Bless the other_list as generic");
+    ok(($one->facet('other_single'))[0]->isa('Test2::API::InterceptResult::Facet'), "Bless the other_single as generic");
+
+    is(($one->facet('other_list'))[0]->foo, undef, "Generic gives us autoload for field access");
+
+    is_deeply(
+        [$one->facet('xxx')],
+        [],
+        "Got an empty list when facet is not present",
+    );
+
+    is_deeply(
+        [$one->facet('assert')],
+        [{pass => 1, details => 'xxx'}],
+        "One item list for non-list facets",
+    );
+
+    is_deeply(
+        [$one->facet('info')],
+        [
+            {tag => 'DIAG', details => 'xxx'},
+            {tag => 'NOTE', details => 'xxx'},
+        ],
+        "Full list for list facets"
+    );
+};
+
+tests the_facet => sub {
+    my $one = $CLASS->new(facet_data => {
+        other_single => {},
+        other_list   => [{}],
+        assert => {pass => 1, details => 'xxx'},
+        info => [
+            {tag => 'DIAG', details => 'xxx'},
+            {tag => 'NOTE', details => 'xxx'},
+        ],
+    });
+
+    ok($one->the_facet('assert')->isa('Test2::EventFacet::Assert'),                "Bless the assert facet");
+    ok($one->the_facet('other_list')->isa('Test2::EventFacet'),                    "Bless the other_list as generic");
+    ok($one->the_facet('other_single')->isa('Test2::EventFacet'),                  "Bless the other_single as generic");
+    ok($one->the_facet('other_list')->isa('Test2::API::InterceptResult::Facet'),   "Bless the other_list as generic");
+    ok($one->the_facet('other_single')->isa('Test2::API::InterceptResult::Facet'), "Bless the other_single as generic");
+
+    is($one->the_facet('other_list')->foo, undef, "Generic gives us autoload for field access");
+
+    is_deeply(
+        $one->the_facet('xxx'),
+        undef,
+        "Got an undef when facet is not present",
+    );
+
+    is_deeply(
+        $one->the_facet('assert'),
+        {pass => 1, details => 'xxx'},
+        "One item",
+    );
+
+    like(
+        exception { $one->the_facet('info') },
+        qr/'the_facet' called for facet 'info', but 'info' has '2' items/,
+        "the_facet dies if there are more than one"
+    );
+};
+
+tests causes_failure => sub {
+    my $one = $CLASS->new(facet_data => { assert => {pass => 1, details => 'xxx'}});
+    ok(!$one->causes_fail, "No failure for passing test");
+    ok(!$one->causes_failure, "No failure for passing test (alt name)");
+
+    my $two = $CLASS->new(facet_data => { assert => {pass => 0, details => 'xxx'}});
+    ok($two->causes_fail, "Failure for failing test");
+    ok($two->causes_failure, "Failure for failing test (alt name)");
+
+    my $three = $CLASS->new(
+        facet_data => {
+            assert  => {pass => 0, details => 'xxx'},
+            amnesty => [{tag => 'TODO', details => 'a todo'}],
+        }
+    );
+    ok(!$three->causes_fail,    "No failure for failing test (with amnesty)");
+    ok(!$three->causes_failure, "No failure for failing test (with amnesty) (alt name)");
+};
+
+tests trace => sub {
+    my $one = $CLASS->new;
+    is($one->trace,         undef, "No trace to get");
+    is($one->frame,         undef, "No frame to get");
+    is($one->trace_details, undef, "No trace to get trace_details from");
+    is($one->trace_file,    undef, "No trace to get trace_file from");
+    is($one->trace_line,    undef, "No trace to get trace_line from");
+    is($one->trace_package, undef, "No trace to get trace_package from");
+    is($one->trace_subname, undef, "No trace to get trace_subname from");
+    is($one->trace_tool,    undef, "No trace to get trace_tool from");
+
+    my $two = $CLASS->new(
+        facet_data => {
+            trace => {
+                frame => [],
+                details => 'xxx',
+                pid => 1,
+                tid => 1,
+            },
+        }
+    );
+    is_deeply($two->the_trace, {details => 'xxx', frame => [], pid => 1, tid => 1}, "Got trace");
+    is_deeply([$two->trace], [{details => 'xxx', frame => [], pid => 1, tid => 1}], "Got trace");
+    is($two->trace_details, 'xxx', "get trace_details");
+    is_deeply($two->frame,         [], "No frame to get");
+    is($two->trace_file,    undef, "No frame to get trace_file from");
+    is($two->trace_line,    undef, "No frame to get trace_line from");
+    is($two->trace_package, undef, "No frame to get trace_package from");
+    is($two->trace_subname, undef, "No frame to get trace_subname from");
+    is($two->trace_tool,    undef, "No frame to get trace_tool from");
+
+    my $three = $CLASS->new(
+        facet_data => {
+            trace => {
+                details => 'xxx',
+                frame   => ['Foo::Bar', 'Foo/Bar.pm', 42, 'ok'],
+                pid => 1,
+                tid => 1,
+            },
+        }
+    );
+    is_deeply($three->the_trace, {details => 'xxx', frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'ok'], pid => 1, tid => 1}, "Got trace");
+    is($three->trace_details, 'xxx', "get trace_details");
+    is_deeply($three->frame, ['Foo::Bar', 'Foo/Bar.pm', 42, 'ok'], "Got frame");
+    is($three->trace_file,    'Foo/Bar.pm', "Got trace_file");
+    is($three->trace_line,    42,           "Got trace_line");
+    is($three->trace_package, 'Foo::Bar',   "Got trace_package");
+    is($three->trace_subname, 'ok',         "Got trace_subname");
+    is($three->trace_tool,    'ok',         "Got trace_tool");
+};
+
+tests brief => sub {
+    my $one = $CLASS->new(
+        facet_data => {
+            control => {halt => 1, details => "some reason to bail out"},
+            errors  => [{tag => 'ERROR', details => "some kind of error"}],
+            assert  => {pass => 1, details => "some passing assert"},
+            plan    => {count => 42},
+        }
+    );
+
+    is($one->brief, $one->bailout_brief, "bail-out is used when present");
+    delete $one->{facet_data}->{control};
+
+    is($one->brief, $one->error_brief, "error is next");
+    delete $one->{facet_data}->{errors};
+
+    is($one->brief, $one->assert_brief, "assert is next");
+    delete $one->{facet_data}->{assert};
+
+    is($one->brief, $one->plan_brief, "plan is last");
+    delete $one->{facet_data}->{plan};
+
+    is_deeply(
+        [$one->brief],
+        [],
+        "Empty list if no briefs are available."
+    );
+};
+
+tests summary => sub {
+    my $one = $CLASS->new();
+
+    is_deeply(
+        $one->summary,
+        {
+            brief => '',
+
+            causes_failure => 0,
+
+            trace_line    => undef,
+            trace_file    => undef,
+            trace_tool    => undef,
+            trace_details => undef,
+
+            facets => [],
+        },
+        "Got summary for empty event"
+    );
+
+    my $two = $CLASS->new(facet_data => {
+        assert => {pass => 0},
+        trace => {frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'ok'], details => 'a trace'},
+        parent => {},
+        plan => {count => 1},
+        control => {halt => 1, details => "bailout wins"},
+        info => [
+            {tag => 'DIAG', details => 'diag 1'},
+            {tag => 'DIAG', details => 'diag 2'},
+            {tag => 'NOTE', details => 'note 1'},
+            {tag => 'NOTE', details => 'note 2'},
+            {tag => 'OTHER', details => 'other 1'},
+            {tag => 'OTHER', details => 'other 2'},
+        ],
+    });
+
+    is_deeply(
+        $two->summary,
+        {
+            brief => 'BAILED OUT: bailout wins',
+
+            causes_failure => 1,
+
+            trace_line    => 42,
+            trace_file    => 'Foo/Bar.pm',
+            trace_tool    => 'ok',
+            trace_details => 'a trace',
+
+            facets => [qw{ assert control info parent plan trace }],
+        },
+        "Got summary for lots"
+    );
+
+    is_deeply(
+        $two->summary(fields => [qw/trace_line trace_file/]),
+        {
+            trace_line    => 42,
+            trace_file    => 'Foo/Bar.pm',
+        },
+        "Got summary, specific fields"
+    );
+
+    is_deeply(
+        $two->summary(remove => [qw/brief facets/]),
+        {
+            causes_failure => 1,
+
+            trace_line    => 42,
+            trace_file    => 'Foo/Bar.pm',
+            trace_tool    => 'ok',
+            trace_details => 'a trace',
+        },
+        "Got summary, removed some fields"
+    );
+};
+
+tests assert => sub {
+    my $one = $CLASS->new();
+    ok(!$one->has_assert, "Not an assert");
+    is_deeply([$one->assert],         [], "empty list for assert()");
+    is_deeply([$one->assert_brief],   [], "empty list for assert_brief()");
+
+    my $two = $CLASS->new(facet_data => {assert => {pass => 1, details => 'foo'}});
+    ok($two->has_assert, "Is an assert");
+    is_deeply([$two->assert], [{pass => 1, details => 'foo'}], "got assert item");
+    is($two->assert_brief, "PASS", "got PASS for assert_brief()");
+
+    my $three = $CLASS->new(facet_data => {
+        assert => {pass => 0, details => 'foo'},
+        amnesty => [
+            {tag => 'TODO', details => 'todo 1'},
+            {tag => 'SKIP', details => 'skip 1'},
+            {tag => 'OOPS', details => 'oops 1'},
+            {tag => 'TODO', details => 'todo 2'},
+            {tag => 'SKIP', details => 'skip 2'},
+            {tag => 'OOPS', details => 'oops 2'},
+        ],
+    });
+    ok($three->has_assert, "Is an assert");
+    is_deeply([$three->assert], [{pass => 0, details => 'foo'}], "got assert item");
+    is($three->assert_brief, "FAIL with amnesty", "Fail with amnesty");
+
+    my $four = $CLASS->new(facet_data => {
+        assert => {pass => 0, details => 'foo'},
+        amnesty => [
+            {tag => 'TODO'},
+            {tag => 'SKIP'},
+            {tag => 'OOPS'},
+        ],
+    });
+    ok($four->has_assert, "Is an assert");
+    is_deeply([$four->assert], [{pass => 0, details => 'foo'}], "got assert item");
+    is($four->assert_brief, "FAIL with amnesty", "Fail with amnesty");
+};
+
+tests subtest => sub {
+    my $one = $CLASS->new();
+    ok(!$one->has_subtest, "Not a subtest");
+    is_deeply([$one->subtest],         [], "subtest() returns empty list");
+    is_deeply([$one->subtest_result],  [], "subtest_result returns an empty list");
+
+    my $two = $CLASS->new(
+        facet_data => {
+            parent => {
+                hid      => '1234',
+                children => [],
+                state    => {
+                    bailed_out   => undef,
+                    count        => 5,
+                    failed       => 1,
+                    follows_plan => 1,
+                    is_passing   => 0,
+                    nested       => 1,
+                    skip_reason  => undef,
+                },
+            },
+        }
+    );
+
+    ok($two->has_subtest, "has a subtest");
+    is_deeply([$two->subtest], [$two->facet_data->{parent}], "subtest() returns 1 item list");
+
+    my $res = $two->subtest_result;
+    ok($res->isa('Test2::API::InterceptResult'), "Got a result instance");
+};
+
+tests flatten => sub {
+    my $one = $CLASS->new();
+    is_deeply(
+        $one->flatten,
+        {
+            causes_failure => 0,
+            trace_file     => undef,
+            trace_line     => undef
+        },
+        "Empty event flattens to almost nothing"
+    );
+
+    my $two = $CLASS->new(
+        facet_data => {
+            hubs    => [{details => "DO NOT SHOW"}],
+            meta    => {details => "DO NOT SHOW"},
+            control => {details => "A control"},
+            assert  => {pass => 1, details => "Test Name"},
+
+            trace => {
+                frame   => ['Foo::Bar', 'Foo/Bar.pm', 42, 'Test2::Tools::Tiny::ok'],
+                details => "Trace Details",
+            },
+
+            parent => {
+                details => "A Subtest",
+                children => [
+                    $CLASS->new(facet_data => {assert => {pass  => 1, details => 'nested assertion'}}),
+                    $CLASS->new(facet_data => {plan   => {count => 1}}),
+                ],
+            },
+
+            errors => [
+                {tag => 'error', fail => 0, details => "not a fatal error"},
+                {tag => 'error', fail => 1, details => "a fatal error"},
+            ],
+
+            info => [
+                {tag => 'DIAG', details => 'diag 1'},
+                {tag => 'DIAG', details => 'diag 2'},
+                {tag => 'NOTE', details => 'note 1'},
+                {tag => 'NOTE', details => 'note 2'},
+                {tag => 'INFO', details => 'info 1'},
+                {tag => 'INFO', details => 'info 2'},
+            ],
+            amnesty => [
+                {tag => 'TODO', details => 'todo 1'},
+                {tag => 'TODO', details => 'todo 2'},
+                {tag => 'SKIP', details => 'skip 1'},
+                {tag => 'SKIP', details => 'skip 2'},
+                {tag => 'OKOK', details => 'okok 1'},
+                {tag => 'OKOK', details => 'okok 2'},
+            ],
+
+            other_single => {details => 'other single'},
+            other_multi  => [{details => 'other multi'}],
+        },
+    );
+
+    is_deeply(
+        $two->flatten(include_subevents => 1),
+        {
+            # Summaries
+            causes_failure => 0,
+            trace_details  => 'Trace Details',
+            trace_file     => 'Foo/Bar.pm',
+            trace_line     => 42,
+
+            # Info
+            diag => ['diag 1', 'diag 2'],
+            info => ['info 1', 'info 2'],
+            note => ['note 1', 'note 2'],
+
+            # Amnesty
+            okok => ['okok 1', 'okok 2'],
+            skip => ['skip 1', 'skip 2'],
+            todo => ['todo 1', 'todo 2'],
+
+            # Errors
+            error => ['not a fatal error', 'FATAL: a fatal error'],
+
+            # Assert
+            name => 'Test Name',
+            pass => 1,
+
+            # Control
+            control => 'A control',
+
+            # Other
+            other_multi  => ['other multi'],
+            other_single => 'other single',
+
+            # Subtest related
+            subtest => {
+                follows_plan => 1,
+                is_passing   => 1,
+                count        => 1,
+                failed       => 0,
+                plan         => 1,
+            },
+
+            subevents => [
+                {
+                    name           => 'nested assertion',
+                    trace_line     => undef,
+                    causes_failure => 0,
+                    pass           => 1,
+                    trace_file     => undef,
+                },
+                {
+                    trace_file     => undef,
+                    plan           => '1',
+                    trace_line     => undef,
+                    causes_failure => 0,
+                }
+            ],
+        },
+        "Very full flattening, with subevents"
+    );
+
+    is_deeply(
+        $two->flatten(),
+        {
+            # Summaries
+            causes_failure => 0,
+            trace_details  => 'Trace Details',
+            trace_file     => 'Foo/Bar.pm',
+            trace_line     => 42,
+
+            # Info
+            diag => ['diag 1', 'diag 2'],
+            info => ['info 1', 'info 2'],
+            note => ['note 1', 'note 2'],
+
+            # Amnesty
+            okok => ['okok 1', 'okok 2'],
+            skip => ['skip 1', 'skip 2'],
+            todo => ['todo 1', 'todo 2'],
+
+            # Errors
+            error => ['not a fatal error', 'FATAL: a fatal error'],
+
+            # Assert
+            name => 'Test Name',
+            pass => 1,
+
+            # Control
+            control => 'A control',
+
+            # Other
+            other_multi  => ['other multi'],
+            other_single => 'other single',
+
+            # Subtest related
+            subtest => {
+                follows_plan => 1,
+                is_passing   => 1,
+                count        => 1,
+                failed       => 0,
+                plan         => 1,
+            },
+        },
+        "Very full flattening, no subevents"
+    );
+
+    my $three = $CLASS->new(
+        facet_data => {
+            trace => {
+                frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'Test2::Tools::Tiny::ok'],
+            },
+
+            control => {halt => 1, details => "need to bail dude!"},
+
+            amnesty => [{tag => 'TODO', details => 'todo 1'}],
+        },
+    );
+
+    is_deeply(
+        $three->flatten(include_subevents => 1),
+        {
+            # Summaries
+            causes_failure => 0,
+
+            trace_file => 'Foo/Bar.pm',
+            trace_line => 42,
+
+            bailed_out => "need to bail dude!",
+
+            # Amnesty does not show without an assert or parent
+        },
+        "Bail-out test"
+    );
+
+    my $four = $CLASS->new(
+        facet_data => {
+            trace   => {frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'Test2::Tools::Tiny::ok']},
+            errors  => [{tag => 'ERROR', details => 'an error', fail => 1}],
+            amnesty => [{tag => 'TODO', details => 'todo 1'}],
+        },
+    );
+
+    is_deeply(
+        $four->flatten(),
+        {
+            # Summaries
+            causes_failure => 0,
+
+            trace_file => 'Foo/Bar.pm',
+            trace_line => 42,
+
+            todo  => ['todo 1'],
+            error => ['FATAL: an error'],
+        },
+        "Include amnesty when there is a fatal error"
+    );
+
+    is_deeply(
+        $four->flatten(fields => [qw/trace_file trace_line/]),
+        {
+            trace_file => 'Foo/Bar.pm',
+            trace_line => 42,
+        },
+        "Filtered to only specific fields"
+    );
+
+    is_deeply(
+        $four->flatten(remove => [qw/todo error/]),
+        {
+            # Summaries
+            causes_failure => 0,
+
+            trace_file => 'Foo/Bar.pm',
+            trace_line => 42,
+        },
+        "Remove specific fields"
+    );
+
+};
+
+tests bailout => sub {
+    my $one = $CLASS->new();
+    ok(!$one->has_bailout, "No bailout");
+    is_deeply([$one->bailout],        [], "no bailout");
+    is_deeply([$one->bailout_brief],  [], "no bailout");
+    is_deeply([$one->bailout_reason], [], "no bailout");
+
+    my $two = $CLASS->new(
+        facet_data => {
+            trace => {
+                frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'Test2::Tools::Tiny::ok'],
+            },
+
+            control => {halt => 1, details => "need to bail dude!"},
+        },
+    );
+
+    ok($two->has_bailout, "did bail out");
+    is_deeply([$two->bailout],        [{halt => 1, details => "need to bail dude!"}], "Got the bailout");
+    is_deeply([$two->bailout_brief],  ["BAILED OUT: need to bail dude!"],             "Got the bailout brief");
+    is_deeply([$two->bailout_reason], ["need to bail dude!"],                         "Got the bailout reason");
+};
+
+tests plan => sub {
+    my $one = $CLASS->new;
+    ok(!$one->has_plan, "No plan");
+    is_deeply([$one->plan], [], "No plan");
+    is_deeply([$one->plan_brief], [], "No plan");
+
+    my $two = $CLASS->new(facet_data => {plan => { count => 42 }});
+    ok($two->has_plan, "Got a plan");
+    is_deeply([$two->plan], [{ count => 42 }], "Got the plan facet");
+    is_deeply([$two->plan_brief], ["PLAN 42"], "Got the brief");
+
+    $two->{facet_data}->{plan}->{details} = "foo bar baz";
+    is_deeply([$two->plan_brief], ["PLAN 42: foo bar baz"], "Got the brief with details");
+
+    $two->{facet_data}->{plan}->{count} = 0;
+    is_deeply([$two->plan_brief], ["SKIP ALL: foo bar baz"], "Got the skip form no count with details");
+
+    $two->{facet_data}->{plan}->{count} = 1;
+    $two->{facet_data}->{plan}->{skip} = 1;
+    is_deeply([$two->plan_brief], ["SKIP ALL: foo bar baz"], "Got the skip with details");
+
+    $two->{facet_data}->{plan}->{skip} = 0;
+    $two->{facet_data}->{plan}->{none} = 1;
+    is_deeply([$two->plan_brief], ["NO PLAN: foo bar baz"], "Got the 'NO PLAN' with details");
+};
+
+tests amnesty => sub {
+    my $one = $CLASS->new();
+
+    ok(!$one->has_amnesty,       "No amnesty");
+    ok(!$one->has_todos,         "No todos");
+    ok(!$one->has_skips,         "No skips");
+    ok(!$one->has_other_amnesty, "No other amnesty");
+
+    is_deeply([$one->amnesty],       [], "amnesty list is empty");
+    is_deeply([$one->todos],         [], "todos list is empty");
+    is_deeply([$one->skips],         [], "skips list is empty");
+    is_deeply([$one->other_amnesty], [], "other_amnesty list is empty");
+
+    is_deeply([$one->amnesty_reasons],       [], "amnesty_reasons list is empty");
+    is_deeply([$one->todo_reasons],          [], "todo_reasons list is empty");
+    is_deeply([$one->skip_reasons],          [], "skip_reasons list is empty");
+    is_deeply([$one->other_amnesty_reasons], [], "other_amnesty_reasons list is empty");
+
+    my $two = $CLASS->new(
+        facet_data => {
+            amnesty => [
+                {tag => 'TODO', details => 'todo 1'},
+                {tag => 'TODO', details => 'todo 2'},
+                {tag => 'SKIP', details => 'skip 1'},
+                {tag => 'SKIP', details => 'skip 2'},
+                {tag => 'OKOK', details => 'okok 1'},
+                {tag => 'OKOK', details => 'okok 2'},
+            ],
+        },
+    );
+
+    ok($two->has_amnesty,       "amnesty");
+    ok($two->has_todos,         "todos");
+    ok($two->has_skips,         "skips");
+    ok($two->has_other_amnesty, "other amnesty");
+
+    is_deeply(
+        [$two->amnesty],
+        [
+            {tag => 'TODO', details => 'todo 1'},
+            {tag => 'TODO', details => 'todo 2'},
+            {tag => 'SKIP', details => 'skip 1'},
+            {tag => 'SKIP', details => 'skip 2'},
+            {tag => 'OKOK', details => 'okok 1'},
+            {tag => 'OKOK', details => 'okok 2'},
+        ],
+        "amnesty list",
+    );
+    is_deeply(
+        [$two->todos],
+        [
+            {tag => 'TODO', details => 'todo 1'},
+            {tag => 'TODO', details => 'todo 2'},
+        ],
+        "todos list",
+    );
+    is_deeply(
+        [$two->skips],
+        [
+            {tag => 'SKIP', details => 'skip 1'},
+            {tag => 'SKIP', details => 'skip 2'},
+        ],
+        "skips list",
+    );
+    is_deeply(
+        [$two->other_amnesty],
+        [
+            {tag => 'OKOK', details => 'okok 1'},
+            {tag => 'OKOK', details => 'okok 2'},
+        ],
+        "other_amnesty list",
+    );
+
+    is_deeply(
+        [$two->amnesty_reasons],
+        [
+            'todo 1',
+            'todo 2',
+            'skip 1',
+            'skip 2',
+            'okok 1',
+            'okok 2',
+        ],
+        "amnesty_reasons list is empty"
+    );
+    is_deeply(
+        [$two->todo_reasons],
+        [
+            'todo 1',
+            'todo 2',
+        ],
+        "todo_reasons list is empty"
+    );
+    is_deeply(
+        [$two->skip_reasons],
+        [
+            'skip 1',
+            'skip 2',
+        ],
+        "skip_reasons list is empty"
+    );
+    is_deeply(
+        [$two->other_amnesty_reasons],
+        [
+            'okok 1',
+            'okok 2',
+        ],
+        "other_amnesty_reasons list is empty"
+    );
+};
+
+tests errors => sub {
+    my $one = $CLASS->new();
+    ok(!$one->has_errors, "No errors");
+    is_deeply([$one->errors], [], "No errors");
+    is_deeply([$one->error_messages], [], "No errors");
+    is_deeply([$one->error_brief], [], "No errors");
+
+    my $two = $CLASS->new(facet_data => {
+        errors => [{tag => 'error', details => 'a non fatal error'}],
+    });
+    ok($two->has_errors, "Got errors");
+    is_deeply([$two->errors], [{tag => 'error', details => 'a non fatal error'}], "Got the error");
+    is_deeply([$two->error_messages], ['a non fatal error'], "Got the message");
+    is_deeply([$two->error_brief], ['ERROR: a non fatal error'], "Got the brief");
+
+    my $three = $CLASS->new(facet_data => {
+        errors => [{tag => 'error', details => "a non fatal\nerror"}],
+    });
+    ok($three->has_errors, "Got errors");
+    is_deeply([$three->errors], [{tag => 'error', details => "a non fatal\nerror"}], "Got the error");
+    is_deeply([$three->error_messages], ["a non fatal\nerror"], "Got the message");
+    is_deeply([$three->error_brief], ["ERROR: a non fatal [...]"], "Got the brief");
+
+    my $four = $CLASS->new(facet_data => {
+        errors => [
+            {tag => 'error', details => "a fatal error", fail => 1},
+            {tag => 'error', details => "a non fatal error", fail => 0},
+        ],
+    });
+
+    ok($four->has_errors, "Got errors");
+
+    is_deeply(
+        [$four->errors],
+        [
+            {tag => 'error', details => "a fatal error", fail => 1},
+            {tag => 'error', details => "a non fatal error", fail => 0},
+        ],
+        "Got the error"
+    );
+
+    is_deeply(
+        [$four->error_messages],
+        [
+            "a fatal error",
+            "a non fatal error",
+        ],
+        "Got the message"
+    );
+
+    is_deeply([$four->error_brief], ['ERRORS: a fatal error [...]'], "Got the brief");
+
+};
+
+tests info => sub {
+    my $one = $CLASS->new();
+
+    ok(!$one->has_info,       "No info");
+    ok(!$one->has_diags,         "No diags");
+    ok(!$one->has_notes,         "No notes");
+    ok(!$one->has_other_info, "No other info");
+
+    is_deeply([$one->info],       [], "info list is empty");
+    is_deeply([$one->diags],         [], "diags list is empty");
+    is_deeply([$one->notes],         [], "notes list is empty");
+    is_deeply([$one->other_info], [], "other_info list is empty");
+
+    is_deeply([$one->info_messages],       [], "info_messages list is empty");
+    is_deeply([$one->diag_messages],          [], "diag_messages list is empty");
+    is_deeply([$one->note_messages],          [], "note_messages list is empty");
+    is_deeply([$one->other_info_messages], [], "other_info_messages list is empty");
+
+    my $two = $CLASS->new(
+        facet_data => {
+            info => [
+                {tag => 'DIAG', details => 'diag 1'},
+                {tag => 'DIAG', details => 'diag 2'},
+                {tag => 'NOTE', details => 'note 1'},
+                {tag => 'NOTE', details => 'note 2'},
+                {tag => 'INFO', details => 'info 1'},
+                {tag => 'INFO', details => 'info 2'},
+            ],
+        },
+    );
+
+    ok($two->has_info,       "info");
+    ok($two->has_diags,         "diags");
+    ok($two->has_notes,         "notes");
+    ok($two->has_other_info, "other info");
+
+    is_deeply(
+        [$two->info],
+        [
+            {tag => 'DIAG', details => 'diag 1'},
+            {tag => 'DIAG', details => 'diag 2'},
+            {tag => 'NOTE', details => 'note 1'},
+            {tag => 'NOTE', details => 'note 2'},
+            {tag => 'INFO', details => 'info 1'},
+            {tag => 'INFO', details => 'info 2'},
+        ],
+        "info list",
+    );
+    is_deeply(
+        [$two->diags],
+        [
+            {tag => 'DIAG', details => 'diag 1'},
+            {tag => 'DIAG', details => 'diag 2'},
+        ],
+        "diags list",
+    );
+    is_deeply(
+        [$two->notes],
+        [
+            {tag => 'NOTE', details => 'note 1'},
+            {tag => 'NOTE', details => 'note 2'},
+        ],
+        "notes list",
+    );
+    is_deeply(
+        [$two->other_info],
+        [
+            {tag => 'INFO', details => 'info 1'},
+            {tag => 'INFO', details => 'info 2'},
+        ],
+        "other_info list",
+    );
+
+    is_deeply(
+        [$two->info_messages],
+        [
+            'diag 1',
+            'diag 2',
+            'note 1',
+            'note 2',
+            'info 1',
+            'info 2',
+        ],
+        "info_messages list is empty"
+    );
+    is_deeply(
+        [$two->diag_messages],
+        [
+            'diag 1',
+            'diag 2',
+        ],
+        "diag_messages list is empty"
+    );
+    is_deeply(
+        [$two->note_messages],
+        [
+            'note 1',
+            'note 2',
+        ],
+        "note_messages list is empty"
+    );
+    is_deeply(
+        [$two->other_info_messages],
+        [
+            'info 1',
+            'info 2',
+        ],
+        "other_info_messages list is empty"
+    );
+};
+
+done_testing;
diff --git a/cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Squasher.t b/cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Squasher.t
new file mode 100644 (file)
index 0000000..b84e0ff
--- /dev/null
@@ -0,0 +1,117 @@
+use strict;
+use warnings;
+
+use Test2::Tools::Tiny;
+use Test2::API::InterceptResult::Squasher;
+use Test2::API::InterceptResult::Event;
+
+my $CLASS = 'Test2::API::InterceptResult::Squasher';
+
+my $trace1 = {pid => $$, tid => 0, cid => 1, frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'ok']};
+my $trace2 = {pid => $$, tid => 0, cid => 2, frame => ['Foo::Bar', 'Foo/Bar.pm', 43, 'note']};
+my $trace3 = {pid => $$, tid => 0, cid => 3, frame => ['Foo::Bar', 'Foo/Bar.pm', 44, 'subtest']};
+my $trace4 = {pid => $$, tid => 0, cid => 4, frame => ['Foo::Bar', 'Foo/Bar.pm', 45, 'diag']};
+
+my @raw = (
+    # These 4 should merge
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace1,
+        info => [{tag => 'DIAG', details => 'about to fail'}],
+    }),
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace1,
+        assert => { pass => 0, details => 'fail' },
+    }),
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace1,
+        info => [{tag => 'DIAG', details => 'it failed'}],
+    }),
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace1,
+        info => [{tag => 'DIAG', details => 'it failed part 2'}],
+    }),
+
+    # Same trace, but should not merge as it has an assert
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace1,
+        assert => { pass => 0, details => 'fail again' },
+        info => [{tag => 'DIAG', details => 'it failed again'}],
+    }),
+
+    # Stand alone note
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace2,
+        info => [{tag => 'NOTE', details => 'Take Note!'}],
+    }),
+
+    # Subtest, note, assert, diag as 3 events, should be merged
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace3,
+        info => [{tag => 'NOTE', details => 'About to start subtest'}],
+    }),
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace3,
+        assert => { pass => 0, details => 'failed subtest' },
+        parent => { details => 'foo', state => {}, children => [] },
+    }),
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace3,
+        info => [{tag => 'DIAG', details => 'Subtest failed'}],
+    }),
+
+    # Stand alone diag
+    Test2::API::InterceptResult::Event->new(facet_data => {
+        trace => $trace4,
+        info => [{tag => 'DIAG', details => 'Diagnosis: Murder'}],
+    }),
+);
+
+my @events;
+my $squasher = $CLASS->new(events => \@events);
+ok($squasher->isa($CLASS), "Got an instanct");
+$squasher->process($_) for @raw;
+$squasher = undef;
+
+is_deeply(
+    [map { $_->facet_data } @events],
+    [
+        {
+            trace  => $trace1,
+            assert => {pass => 0, details => 'fail'},
+            info   => [
+                {tag => 'DIAG', details => 'about to fail'},
+                {tag => 'DIAG', details => 'it failed'},
+                {tag => 'DIAG', details => 'it failed part 2'},
+            ],
+        },
+
+        {
+            trace  => $trace1,
+            assert => {pass => 0, details => 'fail again'},
+            info   => [{tag => 'DIAG', details => 'it failed again'}],
+        },
+
+        {
+            trace => $trace2,
+            info  => [{tag => 'NOTE', details => 'Take Note!'}],
+        },
+
+        {
+            trace  => $trace3,
+            assert => {pass => 0, details => 'failed subtest'},
+            parent => {details => 'foo', state => {}, children => []},
+            info   => [
+                {tag => 'NOTE', details => 'About to start subtest'},
+                {tag => 'DIAG', details => 'Subtest failed'},
+            ],
+        },
+
+        {
+            trace => $trace4,
+            info  => [{tag => 'DIAG', details => 'Diagnosis: Murder'}],
+        },
+    ],
+    "Squashed events as expected"
+);
+
+done_testing;
index 5214baf..9c7a52b 100644 (file)
@@ -47,7 +47,7 @@ is_deeply($one->trace, $trace, "Trace has all data");
 
 $one = $CLASS->new;
 ok(!$one->uuid, "no uuid attribute");
-ok(!$one->about->{uuid}, "no uuid in about facet");
+ok(!($one->about && $one->about->{uuid}), "no uuid in about facet");
 $one->set_uuid(123);
 is($one->about->{uuid}, 123, "Set uuid in about facet");
 is($one->uuid, 123, "set uuid attribute");
diff --git a/cpan/Test-Simple/t/regression/862-intercept_tb_todo.t b/cpan/Test-Simple/t/regression/862-intercept_tb_todo.t
new file mode 100644 (file)
index 0000000..016f9cd
--- /dev/null
@@ -0,0 +1,62 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test2::API qw/intercept/;
+
+my $events;
+{
+    local $TODO = "main-outer-todo";
+
+    package Foo;
+
+    our $TODO;
+    local $TODO = "foo-outer-todo";
+
+    $events = main::intercept(sub {
+        main::ok(1, "assertion 1");
+
+        {
+            local $main::TODO = "main-inner-todo";
+            main::ok(1, "assertion 2");
+        }
+
+        {
+            local $Foo::TODO = "foo-inner-todo";
+            main::ok(1, "assertion 3");
+        }
+
+        main::ok(1, "assertion 4");
+    });
+
+    # Cannot use intercept, so make a failing test, the overall test file
+    # should still pass because this is todo. If this is not todo we know we
+    # broke something by the test failing overall.
+    main::ok(0, "Verifying todo, this should be a failed todo test");
+}
+
+@$events = grep { $_->facet_data->{assert} } @$events;
+
+ok(!$events->[0]->facet_data->{amnesty}, "No amnesty for the first event, \$TODO was cleaned");
+
+is_deeply(
+    $events->[1]->facet_data->{amnesty},
+    [{
+        tag     => 'TODO',
+        details => 'main-inner-todo',
+    }],
+    "The second event had the expected amnesty applied",
+);
+
+is_deeply(
+    $events->[2]->facet_data->{amnesty},
+    [{
+        tag     => 'TODO',
+        details => 'foo-inner-todo',
+    }],
+    "The third event had the expected amnesty applied",
+);
+
+ok(!$events->[3]->facet_data->{amnesty}, "No amnesty for the fourth event, \$TODO was cleaned");
+
+done_testing;