diff options
author | Norbert Preining <norbert@preining.info> | 2022-04-04 03:14:42 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2022-04-04 03:14:42 +0000 |
commit | 7548e4d37c2aaefd32fe0a9bcd83f8e71326dde1 (patch) | |
tree | d335b608e63e9b3c37d7ba0e567c63e77250e171 /systems/texlive/tlnet/tlpkg/tlperl/lib/Test2 | |
parent | 506de1e2d3515161cdbc7018b4ccc9e49d7f86e8 (diff) |
CTAN sync 202204040314
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Test2')
56 files changed, 2234 insertions, 147 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm index 6c517415bd..6c663468ab 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm @@ -9,7 +9,7 @@ BEGIN { $ENV{TEST2_ACTIVE} = 1; } -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Breakage.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Breakage.pm index 2dd2852d0e..b661b9e2b8 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Breakage.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Breakage.pm @@ -2,7 +2,7 @@ package Test2::API::Breakage; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Context.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Context.pm index 177d9c4072..f94993c8e8 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Context.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Context.pm @@ -2,7 +2,7 @@ package Test2::API::Context; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Instance.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Instance.pm index fbbb675cc4..8a0ef99e3d 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Instance.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Instance.pm @@ -2,7 +2,7 @@ package Test2::API::Instance; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult.pm new file mode 100755 index 0000000000..a679ac4806 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult.pm @@ -0,0 +1,634 @@ +package Test2::API::InterceptResult; +use strict; +use warnings; + +our $VERSION = '1.302183'; + +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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Event.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Event.pm new file mode 100755 index 0000000000..860f4966ee --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Event.pm @@ -0,0 +1,1087 @@ +package Test2::API::InterceptResult::Event; +use strict; +use warnings; + +our $VERSION = '1.302183'; + +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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Facet.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Facet.pm new file mode 100755 index 0000000000..ca4a9b38b5 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Facet.pm @@ -0,0 +1,25 @@ +package Test2::API::InterceptResult::Facet; +use strict; +use warnings; + +our $VERSION = '1.302183'; + +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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Hub.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Hub.pm new file mode 100755 index 0000000000..aeb92c7b54 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Hub.pm @@ -0,0 +1,66 @@ +package Test2::API::InterceptResult::Hub; +use strict; +use warnings; + +our $VERSION = '1.302183'; + +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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Squasher.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Squasher.pm new file mode 100755 index 0000000000..ace805e781 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/InterceptResult/Squasher.pm @@ -0,0 +1,196 @@ +package Test2::API::InterceptResult::Squasher; +use strict; +use warnings; + +our $VERSION = '1.302183'; + +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->$_ } '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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Stack.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Stack.pm index d6b6e85c86..b5585a8ef4 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Stack.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API/Stack.pm @@ -2,7 +2,7 @@ package Test2::API::Stack; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event.pm index e1c567a739..99a6fd43cb 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event.pm @@ -2,7 +2,7 @@ package Test2::Event; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Bail.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Bail.pm index 076ac9761d..9b5092def8 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Bail.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Bail.pm @@ -2,7 +2,7 @@ package Test2::Event::Bail; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Diag.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Diag.pm index 9fa732ff4f..fb75235233 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Diag.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Diag.pm @@ -2,7 +2,7 @@ package Test2::Event::Diag; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Encoding.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Encoding.pm index 3fb7364394..831fcebb4d 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Encoding.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Encoding.pm @@ -2,7 +2,7 @@ package Test2::Event::Encoding; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Exception.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Exception.pm index df83ac8714..a02a6012ac 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Exception.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Exception.pm @@ -2,7 +2,7 @@ package Test2::Event::Exception; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Fail.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Fail.pm index f09a035ede..7a1eaa94f2 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Fail.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Fail.pm @@ -2,7 +2,7 @@ package Test2::Event::Fail; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Generic.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Generic.pm index ef08124a16..409fb77bc4 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Generic.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/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.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Note.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Note.pm index 4a310f3cd1..13613f8c96 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Note.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Note.pm @@ -2,7 +2,7 @@ package Test2::Event::Note; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Ok.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Ok.pm index 088c8b6d4d..d39c1dbf84 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Ok.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Ok.pm @@ -2,7 +2,7 @@ package Test2::Event::Ok; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Pass.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Pass.pm index bfc3a73b48..b5050459ce 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Pass.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Pass.pm @@ -2,7 +2,7 @@ package Test2::Event::Pass; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Plan.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Plan.pm index ad8f927552..cc9d8049e3 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Plan.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Plan.pm @@ -2,7 +2,7 @@ package Test2::Event::Plan; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Skip.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Skip.pm index a992324355..75d7db1bd8 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Skip.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Skip.pm @@ -2,7 +2,7 @@ package Test2::Event::Skip; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Subtest.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Subtest.pm index aed0c0061f..89081fa225 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Subtest.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Subtest.pm @@ -2,7 +2,7 @@ package Test2::Event::Subtest; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm index b3cb1d8558..bb90cc5f49 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/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.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/V2.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/V2.pm index 326a818f1d..accab090d6 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/V2.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/V2.pm @@ -2,7 +2,7 @@ package Test2::Event::V2; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Waiting.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Waiting.pm index dbd1448584..0f92a910b7 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Waiting.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Waiting.pm @@ -2,7 +2,7 @@ package Test2::Event::Waiting; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet.pm index 13c217f33f..171e005f85 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet.pm @@ -2,7 +2,7 @@ package Test2::EventFacet; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/About.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/About.pm index f12ebf835a..50dfa4dfe0 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/About.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/About.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::About; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm index 45ed92703c..fb65846f16 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Amnesty; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm index 02f89aff72..ffe2b05439 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Assert; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm index 8a04a4a3a5..891d38f6dd 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Control; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm index 87baf113fb..407e7e7368 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Error; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm index 370142577c..35a75c13a7 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Hub; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm index badd2d0457..2aa38e96bd 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Info; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Info/Table.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Info/Table.pm index 0c127b5a24..351e88b4fa 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Info/Table.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/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.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm index 2b75764eb1..17f78bd59d 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Meta; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm index ac267379cf..82521cd63d 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Parent; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm index 355588b5bc..99349b3575 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Plan; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm index 13fe4cbc91..8cc8b7a8e5 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Render; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm index 455b0ee116..6c4e4550b5 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm @@ -2,14 +2,14 @@ package Test2::EventFacet::Trace; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter.pm index 17c28bf276..981baba2d1 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter.pm @@ -2,7 +2,7 @@ package Test2::Formatter; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm index 120c82d77b..0b1e9475d0 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm @@ -2,7 +2,7 @@ package Test2::Formatter::TAP; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub.pm index e041f6db73..207099b250 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub.pm @@ -2,7 +2,7 @@ package Test2::Hub; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm index 317dfa8c2e..13930c55bd 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm @@ -2,7 +2,7 @@ package Test2::Hub::Interceptor; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm index 906e7b0a03..b37f505745 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/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.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm index acc6369646..7c75eed0a8 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm @@ -2,7 +2,7 @@ package Test2::Hub::Subtest; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC.pm index e9d29cca25..1f6478b6ad 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC.pm @@ -2,7 +2,7 @@ package Test2::IPC; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC/Driver.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC/Driver.pm index db6642a564..35978070e2 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC/Driver.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC/Driver.pm @@ -2,7 +2,7 @@ package Test2::IPC::Driver; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm index 09fdd5c0cf..a443c9193a 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/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.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm index 5139e4607c..c9c5bb3215 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/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.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Transition.pod b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Transition.pod index 07811f0d62..a1b02c95b1 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Transition.pod +++ b/systems/texlive/tlnet/tlpkg/tlperl/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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util.pm index 0ba499557a..b78f80a904 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util.pm @@ -2,7 +2,7 @@ package Test2::Util; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm index 90345d0ecd..cfa0a5699b 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm @@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm index 4bcee18112..0e0ed65dbb 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm @@ -2,7 +2,7 @@ package Test2::Util::Facets2Legacy; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; 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/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/HashBase.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/HashBase.pm index a6a04f9bee..da1bf916a8 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/HashBase.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/HashBase.pm @@ -2,7 +2,7 @@ package Test2::Util::HashBase; use strict; use warnings; -our $VERSION = '1.302175'; +our $VERSION = '1.302183'; ################################################################# # # diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Trace.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Trace.pm index 33b3648789..b374064cbe 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Trace.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/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.302183'; 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. |