diff options
author | Todd Rinaldo <toddr@cpan.org> | 2020-09-15 21:23:31 -0500 |
---|---|---|
committer | Todd Rinaldo <toddr@cpan.org> | 2020-09-15 23:42:34 -0500 |
commit | 18c72c399196d35c6fc14d5bae4f312deceb8359 (patch) | |
tree | 0d62983c705b00b56a1edc1b0166b6179c2bb500 | |
parent | 544e14500f76f6a28da0d5b423ccc23f22723777 (diff) | |
download | perl-18c72c399196d35c6fc14d5bae4f312deceb8359.tar.gz |
Update Test-Simple to CPAN version 1.302181
[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, 3816 insertions, 219 deletions
@@ -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 diff --git a/Makefile.SH b/Makefile.SH index a65c34801b..fa8d9e3793 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -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 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 7a41a465ba..fc46607863 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -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/}, diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index 1a49b7a8e7..b719598aa2 100644 --- a/cpan/Test-Simple/lib/Test/Builder.pm +++ b/cpan/Test-Simple/lib/Test/Builder.pm @@ -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; diff --git a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm index ab405cab98..12a5d03529 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index 6e550eb6f7..882a93dac3 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -7,7 +7,7 @@ use Test::Builder; require Exporter; our @ISA = qw(Exporter); -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; =head1 NAME diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index da98e3d9a0..d34cf4871b 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester; use strict; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; use Test::Builder; use Symbol; diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm index 116e6057d8..c58c1f3652 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester::Color; use strict; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; require Test::Builder::Tester; diff --git a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm index b69ca25266..4b36edd734 100644 --- a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm +++ b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index b2f82286b4..9487e98f96 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -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); diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index 6ff8183b80..c5d922b5a9 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -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); diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm index 1cc7bd179e..cfeddf39d4 100644 --- a/cpan/Test-Simple/lib/Test/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Tester.pm @@ -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 ); diff --git a/cpan/Test-Simple/lib/Test/Tester/Capture.pm b/cpan/Test-Simple/lib/Test/Tester/Capture.pm index c5c454215f..d49a6c96b3 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Capture.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Capture.pm @@ -2,7 +2,7 @@ use strict; package Test::Tester::Capture; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; use Test::Builder; diff --git a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm index a86ef0616c..7e941f08f0 100644 --- a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm +++ b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm @@ -3,7 +3,7 @@ use strict; package Test::Tester::CaptureRunner; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; use Test::Tester::Capture; diff --git a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm index 2036f2ebc2..f90d84c562 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm @@ -3,7 +3,7 @@ use warnings; package Test::Tester::Delegate; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; use Scalar::Util(); diff --git a/cpan/Test-Simple/lib/Test/use/ok.pm b/cpan/Test-Simple/lib/Test/use/ok.pm index 4113ef59c8..04154406c7 100644 --- a/cpan/Test-Simple/lib/Test/use/ok.pm +++ b/cpan/Test-Simple/lib/Test/use/ok.pm @@ -1,7 +1,7 @@ package Test::use::ok; use 5.005; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; __END__ diff --git a/cpan/Test-Simple/lib/Test2.pm b/cpan/Test-Simple/lib/Test2.pm index d915631070..6afd64c8df 100644 --- a/cpan/Test-Simple/lib/Test2.pm +++ b/cpan/Test-Simple/lib/Test2.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/API.pm b/cpan/Test-Simple/lib/Test2/API.pm index 6c517415bd..f0ddca8802 100644 --- a/cpan/Test-Simple/lib/Test2/API.pm +++ b/cpan/Test-Simple/lib/Test2/API.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/API/Breakage.pm b/cpan/Test-Simple/lib/Test2/API/Breakage.pm index 2dd2852d0e..55471bb8a0 100644 --- a/cpan/Test-Simple/lib/Test2/API/Breakage.pm +++ b/cpan/Test-Simple/lib/Test2/API/Breakage.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/API/Context.pm b/cpan/Test-Simple/lib/Test2/API/Context.pm index 177d9c4072..ff438a6fca 100644 --- a/cpan/Test-Simple/lib/Test2/API/Context.pm +++ b/cpan/Test-Simple/lib/Test2/API/Context.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/API/Instance.pm b/cpan/Test-Simple/lib/Test2/API/Instance.pm index fbbb675cc4..988f83de61 100644 --- a/cpan/Test-Simple/lib/Test2/API/Instance.pm +++ b/cpan/Test-Simple/lib/Test2/API/Instance.pm @@ -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 index 0000000000..c22e877b2f --- /dev/null +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult.pm @@ -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 index 0000000000..4e8082011e --- /dev/null +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm @@ -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 index 0000000000..5964037e48 --- /dev/null +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm @@ -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 index 0000000000..a703096b4b --- /dev/null +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm @@ -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 index 0000000000..c4de89ca33 --- /dev/null +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm @@ -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 diff --git a/cpan/Test-Simple/lib/Test2/API/Stack.pm b/cpan/Test-Simple/lib/Test2/API/Stack.pm index d6b6e85c86..272a027b63 100644 --- a/cpan/Test-Simple/lib/Test2/API/Stack.pm +++ b/cpan/Test-Simple/lib/Test2/API/Stack.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event.pm b/cpan/Test-Simple/lib/Test2/Event.pm index e1c567a739..e84fd06ea6 100644 --- a/cpan/Test-Simple/lib/Test2/Event.pm +++ b/cpan/Test-Simple/lib/Test2/Event.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Bail.pm b/cpan/Test-Simple/lib/Test2/Event/Bail.pm index 076ac9761d..f6c0135f97 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Bail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Bail.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Diag.pm b/cpan/Test-Simple/lib/Test2/Event/Diag.pm index 9fa732ff4f..43f26f205a 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Diag.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Diag.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Encoding.pm b/cpan/Test-Simple/lib/Test2/Event/Encoding.pm index 3fb7364394..1be7d12e99 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Encoding.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Encoding.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Exception.pm b/cpan/Test-Simple/lib/Test2/Event/Exception.pm index df83ac8714..93ec0d0dc7 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Exception.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Exception.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Fail.pm b/cpan/Test-Simple/lib/Test2/Event/Fail.pm index f09a035ede..1b80ec4953 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Fail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Fail.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Generic.pm b/cpan/Test-Simple/lib/Test2/Event/Generic.pm index ef08124a16..b7c124bd90 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Generic.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Generic.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Note.pm b/cpan/Test-Simple/lib/Test2/Event/Note.pm index 4a310f3cd1..f15f1449df 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Note.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Note.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Ok.pm b/cpan/Test-Simple/lib/Test2/Event/Ok.pm index 088c8b6d4d..61d5a0ab0e 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Ok.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Ok.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Pass.pm b/cpan/Test-Simple/lib/Test2/Event/Pass.pm index bfc3a73b48..a01ebd9454 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Pass.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Pass.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Plan.pm b/cpan/Test-Simple/lib/Test2/Event/Plan.pm index ad8f927552..3cdd10499c 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Plan.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Skip.pm b/cpan/Test-Simple/lib/Test2/Event/Skip.pm index a992324355..3452490642 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Skip.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Skip.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm index aed0c0061f..c95c516e4f 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm b/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm index b3cb1d8558..d8679d91fe 100644 --- a/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm +++ b/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/V2.pm b/cpan/Test-Simple/lib/Test2/Event/V2.pm index 326a818f1d..c621625be5 100644 --- a/cpan/Test-Simple/lib/Test2/Event/V2.pm +++ b/cpan/Test-Simple/lib/Test2/Event/V2.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm index dbd1448584..ce28a8583b 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet.pm b/cpan/Test-Simple/lib/Test2/EventFacet.pm index 13c217f33f..84910af34e 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/About.pm b/cpan/Test-Simple/lib/Test2/EventFacet/About.pm index f12ebf835a..1d99b54874 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/About.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/About.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm index 45ed92703c..ef84ab4fd3 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm index 02f89aff72..62611b68e9 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm index 8a04a4a3a5..eb083d9223 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm index 87baf113fb..0e47cf2c0b 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm index 370142577c..572c048e29 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm index badd2d0457..b474596cfc 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm index 0c127b5a24..2326b66948 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm index 2b75764eb1..af065cad1f 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm index ac267379cf..35dda12837 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm index 355588b5bc..45f96c9dd1 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm index 13fe4cbc91..4afb364623 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm index 455b0ee116..3fa9346042 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Formatter.pm b/cpan/Test-Simple/lib/Test2/Formatter.pm index 17c28bf276..cc4bf939ce 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm index 120c82d77b..99fccb84c1 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Hub.pm b/cpan/Test-Simple/lib/Test2/Hub.pm index e041f6db73..efa521b3d9 100644 --- a/cpan/Test-Simple/lib/Test2/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/Hub.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm index 317dfa8c2e..2358a0b518 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm index 906e7b0a03..e89796fc54 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm index acc6369646..73dbfd6c41 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/IPC.pm b/cpan/Test-Simple/lib/Test2/IPC.pm index e9d29cca25..9ddd33c881 100644 --- a/cpan/Test-Simple/lib/Test2/IPC.pm +++ b/cpan/Test-Simple/lib/Test2/IPC.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm index db6642a564..2ca2fa8e90 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm index 09fdd5c0cf..421b9c18cb 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm b/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm index 5139e4607c..59f6eeff13 100644 --- a/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm +++ b/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Transition.pod b/cpan/Test-Simple/lib/Test2/Transition.pod index 07811f0d62..a1b02c95b1 100644 --- a/cpan/Test-Simple/lib/Test2/Transition.pod +++ b/cpan/Test-Simple/lib/Test2/Transition.pod @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Util.pm b/cpan/Test-Simple/lib/Test2/Util.pm index 0ba499557a..4b297c7b9b 100644 --- a/cpan/Test-Simple/lib/Test2/Util.pm +++ b/cpan/Test-Simple/lib/Test2/Util.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm index 90345d0ecd..45f6ca6af8 100644 --- a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm +++ b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm b/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm index 4bcee18112..2afaea7728 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm index a6a04f9bee..904769894b 100644 --- a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm +++ b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm @@ -2,7 +2,7 @@ package Test2::Util::HashBase; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; ################################################################# # # diff --git a/cpan/Test-Simple/lib/Test2/Util/Trace.pm b/cpan/Test-Simple/lib/Test2/Util/Trace.pm index 33b3648789..b61c23b44d 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Trace.pm @@ -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. diff --git a/cpan/Test-Simple/lib/ok.pm b/cpan/Test-Simple/lib/ok.pm index f3b394d9f6..99b32e06ee 100644 --- a/cpan/Test-Simple/lib/ok.pm +++ b/cpan/Test-Simple/lib/ok.pm @@ -1,5 +1,5 @@ package ok; -our $VERSION = '1.302175'; +our $VERSION = '1.302181'; use strict; use Test::More (); diff --git a/cpan/Test-Simple/t/Legacy/Builder/current_test.t b/cpan/Test-Simple/t/Legacy/Builder/current_test.t index edd201c0e9..b8979c64c6 100644 --- a/cpan/Test-Simple/t/Legacy/Builder/current_test.t +++ b/cpan/Test-Simple/t/Legacy/Builder/current_test.t @@ -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 index 0000000000..9758d242f6 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Regression/870-experimental-warnings.t @@ -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; diff --git a/cpan/Test-Simple/t/Legacy/buffer.t b/cpan/Test-Simple/t/Legacy/buffer.t index 1e7b6c9e08..4829109761 100644 --- a/cpan/Test-Simple/t/Legacy/buffer.t +++ b/cpan/Test-Simple/t/Legacy/buffer.t @@ -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"; diff --git a/cpan/Test-Simple/t/Legacy/fail-like.t b/cpan/Test-Simple/t/Legacy/fail-like.t index 4ec99aeab0..02f9539963 100644 --- a/cpan/Test-Simple/t/Legacy/fail-like.t +++ b/cpan/Test-Simple/t/Legacy/fail-like.t @@ -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 diff --git a/cpan/Test-Simple/t/Legacy/is_deeply_fail.t b/cpan/Test-Simple/t/Legacy/is_deeply_fail.t index 21efe87a25..c43b3a2e12 100644 --- a/cpan/Test-Simple/t/Legacy/is_deeply_fail.t +++ b/cpan/Test-Simple/t/Legacy/is_deeply_fail.t @@ -11,6 +11,7 @@ BEGIN { } use strict; +use warnings; use Test::Builder; require Test::Simple::Catch; diff --git a/cpan/Test-Simple/t/Legacy/todo.t b/cpan/Test-Simple/t/Legacy/todo.t index 7d28846857..c5e5a232cf 100644 --- a/cpan/Test-Simple/t/Legacy/todo.t +++ b/cpan/Test-Simple/t/Legacy/todo.t @@ -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 index 0000000000..4e9628fb01 --- /dev/null +++ b/cpan/Test-Simple/t/Test2/modules/API/InterceptResult.t @@ -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 index 0000000000..e1b2716474 --- /dev/null +++ b/cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Event.t @@ -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 index 0000000000..b84e0ff354 --- /dev/null +++ b/cpan/Test-Simple/t/Test2/modules/API/InterceptResult/Squasher.t @@ -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; diff --git a/cpan/Test-Simple/t/Test2/modules/Event/V2.t b/cpan/Test-Simple/t/Test2/modules/Event/V2.t index 5214bafd4d..9c7a52b8ad 100644 --- a/cpan/Test-Simple/t/Test2/modules/Event/V2.t +++ b/cpan/Test-Simple/t/Test2/modules/Event/V2.t @@ -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 index 0000000000..016f9cd459 --- /dev/null +++ b/cpan/Test-Simple/t/regression/862-intercept_tb_todo.t @@ -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; |