diff options
author | Norbert Preining <norbert@preining.info> | 2021-04-02 03:20:54 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2021-04-02 03:20:54 +0000 |
commit | 3f173002d4a4a84e7d1fa5a74755fdd00d08a9c2 (patch) | |
tree | 5ed380344702de1f9ab53b68b6c3bcd6b8458087 /systems/texlive/tlnet/tlpkg/tlperl/lib/Test2 | |
parent | f78ba658b3ecd56053fe0837a4404d0c6c16a707 (diff) |
CTAN sync 202104020320
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Test2')
51 files changed, 276 insertions, 96 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm index 8193b07366..6c517415bd 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm @@ -9,14 +9,44 @@ BEGIN { $ENV{TEST2_ACTIVE} = 1; } -our $VERSION = '1.302162'; +our $VERSION = '1.302175'; my $INST; my $ENDING = 0; -sub test2_set_is_end { ($ENDING) = @_ ? @_ : (1) } +sub test2_unset_is_end { $ENDING = 0 } sub test2_get_is_end { $ENDING } +sub test2_set_is_end { + my $before = $ENDING; + ($ENDING) = @_ ? @_ : (1); + + # Only send the event in a transition from false to true + return if $before; + return unless $ENDING; + + return unless $INST; + my $stack = $INST->stack or return; + my $root = $stack->root or return; + + return unless $root->count; + + return unless $$ == $INST->pid; + return unless get_tid() == $INST->tid; + + my $trace = Test2::EventFacet::Trace->new( + frame => [__PACKAGE__, __FILE__, __LINE__, __PACKAGE__ . '::test2_set_is_end'], + ); + my $ctx = Test2::API::Context->new( + trace => $trace, + hub => $root, + ); + + $ctx->send_ev2(control => { phase => 'END', details => 'Transition to END phase' }); + + 1; +} + use Test2::API::Instance(\$INST); # Set the exit status @@ -85,8 +115,10 @@ our @EXPORT_OK = qw{ test2_start_preload test2_stop_preload test2_in_preload + test2_is_testing_done test2_set_is_end + test2_unset_is_end test2_get_is_end test2_pid @@ -176,6 +208,27 @@ sub test2_ipc_wait_enable { $INST->set_no_wait(0) } sub test2_ipc_wait_disable { $INST->set_no_wait(1) } sub test2_ipc_wait_enabled { !$INST->no_wait } +sub test2_is_testing_done { + # No instance? VERY DONE! + return 1 unless $INST; + + # No stack? tests must be done, it is created pretty early + my $stack = $INST->stack or return 1; + + # Nothing on the stack, no root hub yet, likely have not started testing + return 0 unless @$stack; + + # Stack has a slot for the root hub (see above) but it is undefined, likely + # garbage collected, test is done + my $root_hub = $stack->[0] or return 1; + + # If the root hub is ended than testing is done. + return 1 if $root_hub->ended; + + # Looks like we are still testing! + return 0; +} + sub test2_no_wait { $INST->set_no_wait(@_) if @_; $INST->no_wait; @@ -322,6 +375,23 @@ sub context { my $stack = $params{stack} || $STACK; my $hub = $params{hub} || (@$stack ? $stack->[-1] : $stack->top); + + # Catch an edge case where we try to get context after the root hub has + # been garbage collected resulting in a stack that has a single undef + # hub + if (!$hub && !exists($params{hub}) && @$stack) { + my $msg = Carp::longmess("Attempt to get Test2 context after testing has completed (did you attempt a testing event after done_testing?)"); + + # The error message is usually masked by the global destruction, so we have to print to STDER + print STDERR $msg; + + # Make sure this is a failure, we are probably already in END, so set $? to change the exit code + $? = 1; + + # Now we actually die to interrupt the program flow and avoid undefined his warnings + die $msg; + } + my $hid = $hub->{hid}; my $current = $CONTEXTS->{$hid}; @@ -814,6 +884,7 @@ C<intercept { ... }> which only lets you see events as the main hub sees them. test2_ipc test2_formatter_set test2_formatter + test2_is_testing_done }; my $init = test2_init_done(); @@ -1257,6 +1328,26 @@ Check if Test2 believes it is the END phase. This will return the global L<Test2::API::Stack> instance. If this has not yet been initialized it will be initialized now. +=item $bool = test2_is_testing_done() + +This will return true if testing is complete and no other events should be +sent. This is useful in things like warning handlers where you might want to +turn warnings into events, but need them to start acting like normal warnings +when testing is done. + + $SIG{__WARN__} = sub { + my ($warning) = @_; + + if (test2_is_testing_done()) { + warn @_; + } + else { + my $ctx = context(); + ... + $ctx->release + } + } + =item test2_ipc_disable Disable IPC. 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 ffcf1be582..2dd2852d0e 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.302162'; +our $VERSION = '1.302175'; use Test2::Util qw/pkg_to_file/; @@ -73,7 +73,9 @@ sub report { next unless $INC{$file} || ($require && eval { require $file; 1 }); my $want = $suggest{$mod}; next if eval { $mod->VERSION($want); 1 }; - push @warn => " * Module '$mod' is outdated, we recommed updating above $want."; + my $error = $@; + chomp $error; + push @warn => " * Module '$mod' is outdated, we recommed updating above $want. error was: '$error'; INC is $INC{$file}"; } for my $mod (keys %required) { 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 9cb1cfca72..177d9c4072 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.302162'; +our $VERSION = '1.302175'; use Carp qw/confess croak/; @@ -71,6 +71,8 @@ sub DESTROY { # show the warning about using eq. no warnings 'uninitialized'; if($self->{+EVAL_ERROR} eq $@ && $hub->is_local) { + require Carp; + my $mess = Carp::longmess("Context destroyed"); my $frame = $self->{+_IS_SPAWN} || $self->{+TRACE}->frame; warn <<" EOT"; A context appears to have been destroyed without first calling release(). @@ -87,6 +89,10 @@ release(): Line: $frame->[2] Tool: $frame->[3] +Here is a trace to the code that caused the context to be destroyed, this could +be an exit(), a goto, or simply the end of a scope: +$mess + Cleaning up the CONTEXT stack... EOT } 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 1cf224cf06..fbbb675cc4 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.302162'; +our $VERSION = '1.302175'; our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/; use Carp qw/confess carp/; 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 ffa4ed57f0..d6b6e85c86 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.302162'; +our $VERSION = '1.302175'; use Test2::Hub(); @@ -63,6 +63,12 @@ sub all { return @$self; } +sub root { + my $self = shift; + return unless @$self; + return $self->[0]; +} + sub clear { my $self = shift; @$self = (); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event.pm index 598456c1dc..e1c567a739 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.302162'; +our $VERSION = '1.302175'; use Scalar::Util qw/blessed reftype/; use Carp qw/croak/; @@ -526,11 +526,11 @@ perhaps to say that an event of an unknown type was seen. Facets are produced by the C<facet_data()> subroutine, which you should nearly-always override. C<facet_data()> is expected to return a hashref where each key is the facet type, and the value is either a hashref with the data for -that facet, or an array of hashref's. Some facets must be defined as single +that facet, or an array of hashrefs. Some facets must be defined as single hashrefs, some must be defined as an array of hashrefs, No facets allow both. C<facet_data()> B<MUST NOT> bless the data it returns, the main hashref, and -nested facet hashref's B<MUST> be bare, though items contained within each +nested facet hashrefs B<MUST> be bare, though items contained within each facet may be blessed. The data returned by this method B<should> also be copies of the internal data in order to prevent accidental state modification. 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 4fa83c4899..076ac9761d 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } 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 86617f8afc..9fa732ff4f 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } 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 12071637af..3fb7364394 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.302162'; +our $VERSION = '1.302175'; use Carp qw/croak/; 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 66bbdb4fb4..df83ac8714 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } 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 2577cd9338..f09a035ede 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.302162'; +our $VERSION = '1.302175'; use Test2::EventFacet::Info; 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 02619d9a17..ef08124a16 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase; 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 3dd0999844..4a310f3cd1 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } 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 7a603b40ca..088c8b6d4d 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } 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 4672623430..bfc3a73b48 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.302162'; +our $VERSION = '1.302175'; use Test2::EventFacet::Info; 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 00b63970f7..ad8f927552 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } 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 07db32932a..a992324355 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } 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 92e3f6dfa1..aed0c0061f 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } use Test2::Util::HashBase qw{subevents buffered subtest_id subtest_uuid}; 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 cf7d773e1f..b3cb1d8558 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.302162'; +our $VERSION = '1.302175'; use Carp qw/croak/; 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 020cf2348e..326a818f1d 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.302162'; +our $VERSION = '1.302175'; use Scalar::Util qw/reftype/; use Carp qw/croak/; @@ -60,8 +60,8 @@ sub facet_data { for my $k (keys %$f) { next if substr($k, 0, 1) eq '_'; - my $data = $f->{$k}; - my $is_list = reftype($data) eq 'ARRAY'; + my $data = $f->{$k} or next; # Key is there, but no facet + my $is_list = 'ARRAY' eq (reftype($data) || ''); $out{$k} = $is_list ? [ map { {%{$_}} } @$data ] : {%$data}; } 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 4b790a6ff9..dbd1448584 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet.pm index d9fb03f451..13c217f33f 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.302162'; +our $VERSION = '1.302175'; use Test2::Util::HashBase qw/-details/; use Carp qw/croak/; 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 fc36d2766a..f12ebf835a 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use Test2::Util::HashBase qw{ -package -no_display -uuid -eid }; 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 ac72cf3890..45ed92703c 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.302162'; +our $VERSION = '1.302175'; sub is_list { 1 } 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 a11aef1569..02f89aff72 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use Test2::Util::HashBase qw{ -pass -no_debug -number }; 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 6ea0eaef40..8a04a4a3a5 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm @@ -2,10 +2,10 @@ package Test2::EventFacet::Control; use strict; use warnings; -our $VERSION = '1.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } -use Test2::Util::HashBase qw{ -global -terminate -halt -has_callback -encoding }; +use Test2::Util::HashBase qw{ -global -terminate -halt -has_callback -encoding -phase }; 1; @@ -65,6 +65,13 @@ True if the C<callback($hub)> method on the event should be called. This can be used to change the encoding from this event onward. +=item $phase = $control->{phase} + +=item $phase = $control->phase() + +Used to signal that a phase change has occurred. Currently only the perl END +phase is signaled. + =back =head1 SOURCE 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 4a21ef7e28..87baf113fb 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.302162'; +our $VERSION = '1.302175'; sub facet_key { 'errors' } sub is_list { 1 } 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 40b9d65802..370142577c 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.302162'; +our $VERSION = '1.302175'; sub is_list { 1 } sub facet_key { 'hubs' } 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 c382049480..badd2d0457 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.302162'; +our $VERSION = '1.302175'; sub is_list { 1 } 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 64bd95539a..0c127b5a24 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,6 +2,8 @@ package Test2::EventFacet::Info::Table; use strict; use warnings; +our $VERSION = '1.302175'; + use Carp qw/confess/; use Test2::Util::HashBase qw{-header -rows -collapse -no_collapse -as_string}; 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 dc369ff2b1..2b75764eb1 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use vars qw/$AUTOLOAD/; 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 d36fd92b27..ac267379cf 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.302162'; +our $VERSION = '1.302175'; use Carp qw/confess/; 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 2f14f7d69e..355588b5bc 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use Test2::Util::HashBase qw{ -count -skip -none }; 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 07c454365a..13fe4cbc91 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.302162'; +our $VERSION = '1.302175'; sub is_list { 1 } 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 34a3fce7ad..455b0ee116 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Trace; use strict; use warnings; -our $VERSION = '1.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Formatter.pm index c4515d8c41..17c28bf276 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.302162'; +our $VERSION = '1.302175'; my %ADDED; 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 25961bf737..120c82d77b 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.302162'; +our $VERSION = '1.302175'; use Test2::Util qw/clone_io/; @@ -16,16 +16,17 @@ sub OUT_ERR() { 1 } BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) } -# Not constants because this is a method, and can be overriden -BEGIN { - local $SIG{__DIE__} = 'DEFAULT'; - local $@; - if (($INC{'Term/Table.pm'} && $INC{'Term/Table/Util.pm'}) || eval { require Term::Table; require Term::Table::Util; 1 }) { - *supports_tables = sub { 1 }; - } - else { - *supports_tables = sub { 0 }; +my $supports_tables; +sub supports_tables { + if (!defined $supports_tables) { + local $SIG{__DIE__} = 'DEFAULT'; + local $@; + $supports_tables + = ($INC{'Term/Table.pm'} && $INC{'Term/Table/Util.pm'}) + || eval { require Term::Table; require Term::Table::Util; 1 } + || 0; } + return $supports_tables; } sub _autoflush { @@ -270,7 +271,10 @@ sub assert_tap { } my %seen; - my @order = grep { !$seen{$_}++ } sort keys %directives; + + # Sort so that TODO comes before skip even on systems where lc sorts + # before uc, as other code depends on that ordering. + my @order = grep { !$seen{$_}++ } sort { lc $b cmp lc $a } keys %directives; $directives = ' # ' . join ' & ' => @order; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Hub.pm index a5706e5677..e041f6db73 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.302162'; +our $VERSION = '1.302175'; use Carp qw/carp croak confess/; @@ -813,7 +813,7 @@ Get the IPC object used by the hub. This can be used to disable auto-ending behavior for a hub. The auto-ending behavior is triggered by an end block and is used to cull IPC events, and -output the final plan if the plan was 'no_plan'. +output the final plan if the plan was 'NO PLAN'. =item $bool = $hub->active @@ -861,7 +861,7 @@ pass/fail status. =item $plan = $hub->plan Get or set the plan. The plan must be an integer larger than 0, the string -'no_plan', or the string 'skip_all'. +'NO PLAN', or the string 'SKIP'. =item $bool = $hub->check_plan 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 cd459ada06..317dfa8c2e 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.302162'; +our $VERSION = '1.302175'; use Test2::Hub::Interceptor::Terminator(); 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 6f44b08bcd..906e7b0a03 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.302162'; +our $VERSION = '1.302175'; 1; 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 52d5b4e0fa..acc6369646 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) } use Test2::Util::HashBase qw/nested exit_code manual_skip_all/; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC.pm index b2a503bfa7..e9d29cca25 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.302162'; +our $VERSION = '1.302175'; use Test2::API::Instance; 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 dbcb7004b3..db6642a564 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.302162'; +our $VERSION = '1.302175'; use Carp qw/confess/; 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 f6d7ff1b2c..09fdd5c0cf 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) } @@ -117,12 +117,36 @@ sub drop_hub { } opendir(my $dh, $tdir) or $self->abort_trace("Could not open temp dir!"); + + my %bad; for my $file (readdir($dh)) { next if $file =~ m{\.complete$}; next unless $file =~ m{^$hid}; - $self->abort_trace("Not all files from hub '$hid' have been collected!"); + + eval { $bad{$file} = $self->read_event_file(File::Spec->catfile($tdir, $file)); 1 } or $bad{$file} = $@ || "Unknown error reading file"; } closedir($dh); + + return unless keys %bad; + + my $data; + my $ok = eval { + require JSON::PP; + local *UNIVERSAL::TO_JSON = sub { +{ %{$_[0]} } }; + my $json = JSON::PP->new->ascii->pretty->canonical->allow_unknown->allow_blessed->convert_blessed; + $data = $json->encode(\%bad); + 1; + }; + $ok ||= eval { + require Data::Dumper; + local $Data::Dumper::Sortkeys = 1; + $data = Data::Dumper::Dumper(\%bad); + 1; + }; + + $data = "Could not dump data... sorry." unless defined $data; + + $self->abort_trace("Not all files from hub '$hid' have been collected!\nHere is the leftover data:\n========================\n$data\n===================\n"); } sub send { 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 4da76a79ba..5139e4607c 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.302162'; +our $VERSION = '1.302175'; BEGIN { require Exporter; our @ISA = qw(Exporter) } our @EXPORT = qw{ diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Transition.pod b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Transition.pod index de6442ce61..07811f0d62 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Transition.pod +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Transition.pod @@ -76,7 +76,7 @@ as needed. =head3 The Problem An early change, in fact the change that made Test2 an idea, was a change to -the indentation of the subtest note. IT was decided it would be more readable +the indentation of the subtest note. It was decided it would be more readable to outdent the subtest note instead of having it inline with the subtest: # subtest foo @@ -104,7 +104,7 @@ This breaks tests that do string comparison of TAP output. ); Check if C<$INC{'Test2/API.pm'}> is set, if it is then no indentation should be -expected. If it is not set than the old Test::Builder is in use, indentation +expected. If it is not set, then the old Test::Builder is in use, indentation should be expected. =head1 DISTRIBUTIONS THAT BREAK OR NEED TO BE UPGRADED @@ -129,13 +129,6 @@ failure. This can be easily updated, but nobody has done so yet. Known broken in versions: 1.0.9 and older -=item Test::Kit - -This actually works fine, but will not install because L<Test::Aggregate> is in -the dependency chain. - -See the L<Test::Aggregate> info below for additional information. - =item Device::Chip Tests break due to subtest indentation. @@ -201,6 +194,13 @@ the bugfix. Fixed in version: 0.04 +=item Test::Kit + +Old versions work fine, but would not install because L<Test::Aggregate> was in +the dependency chain. An upgrade should not be needed. + +Fixed in version: 2.15 + =item autouse A test broke because it depended on Scalar::Util not being loaded. Test2 loads @@ -274,8 +274,8 @@ Fixed in version: 0.007 This distribution directly accesses the hash keys in the L<Test::Builder> singleton. It also approaches the problem from the wrong angle, please consider -using L<Test2::Harness> or L<App::ForkProve> which both solve the same problem -at the harness level. +using L<Test2::Aggregate> for similar functionality and L<Test2::Harness> +which allows module preloading at the harness level. Still broken as of version: 0.373 diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util.pm index c4a865e9b1..0ba499557a 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.302162'; +our $VERSION = '1.302175'; use POSIX(); use Config qw/%Config/; 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 dbd819feea..90345d0ecd 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.302162'; +our $VERSION = '1.302175'; use Carp qw/croak/; 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 812282d157..4bcee18112 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.302162'; +our $VERSION = '1.302175'; use Carp qw/croak confess/; use Scalar::Util qw/blessed/; 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 c34db5fc56..a6a04f9bee 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.302162'; +our $VERSION = '1.302175'; ################################################################# # # @@ -16,7 +16,7 @@ our $VERSION = '1.302162'; { no warnings 'once'; - $Test2::Util::HashBase::HB_VERSION = '0.006'; + $Test2::Util::HashBase::HB_VERSION = '0.009'; *Test2::Util::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS; *Test2::Util::HashBase::ATTR_LIST = \%Object::HashBase::ATTR_LIST; *Test2::Util::HashBase::VERSION = \%Object::HashBase::VERSION; @@ -44,9 +44,12 @@ BEGIN { } } -my %STRIP = ( - '^' => 1, - '-' => 1, +my %SPEC = ( + '^' => {reader => 1, writer => 0, dep_writer => 1, read_only => 0, strip => 1}, + '-' => {reader => 1, writer => 0, dep_writer => 0, read_only => 1, strip => 1}, + '>' => {reader => 0, writer => 1, dep_writer => 0, read_only => 0, strip => 1}, + '<' => {reader => 1, writer => 0, dep_writer => 0, read_only => 0, strip => 1}, + '+' => {reader => 0, writer => 0, dep_writer => 0, read_only => 0, strip => 1}, ); sub import { @@ -68,14 +71,22 @@ sub import { map { my $p = substr($_, 0, 1); my $x = $_; - substr($x, 0, 1) = '' if $STRIP{$p}; + + my $spec = $SPEC{$p} || {reader => 1, writer => 1}; + + substr($x, 0, 1) = '' if $spec->{strip}; push @$attr_list => $x; my ($sub, $attr) = (uc $x, $x); - $sub => ($attr_subs->{$sub} = sub() { $attr }), - $attr => sub { $_[0]->{$attr} }, - $p eq '-' ? ("set_$attr" => sub { Carp::croak("'$attr' is read-only") }) - : $p eq '^' ? ("set_$attr" => sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] }) - : ("set_$attr" => sub { $_[0]->{$attr} = $_[1] }), + + $attr_subs->{$sub} = sub() { $attr }; + my %out = ($sub => $attr_subs->{$sub}); + + $out{$attr} = sub { $_[0]->{$attr} } if $spec->{reader}; + $out{"set_$attr"} = sub { $_[0]->{$attr} = $_[1] } if $spec->{writer}; + $out{"set_$attr"} = sub { Carp::croak("'$attr' is read-only") } if $spec->{read_only}; + $out{"set_$attr"} = sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] } if $spec->{dep_writer}; + + %out; } @_ ), ); @@ -167,7 +178,7 @@ A class: use warnings; # Generate 3 accessors - use Test2::Util::HashBase qw/foo -bar ^baz/; + use Test2::Util::HashBase qw/foo -bar ^baz <bat >ban +boo/; # Chance to initialize defaults sub init { @@ -175,10 +186,13 @@ A class: $self->{+FOO} ||= "foo"; $self->{+BAR} ||= "bar"; $self->{+BAZ} ||= "baz"; + $self->{+BAT} ||= "bat"; + $self->{+BAN} ||= "ban"; + $self->{+BOO} ||= "boo"; } sub print { - print join ", " => map { $self->{$_} } FOO, BAR, BAZ; + print join ", " => map { $self->{$_} } FOO, BAR, BAZ, BAT, BAN, BOO; } Subclass it @@ -189,14 +203,14 @@ Subclass it # Note, you should subclass before loading HashBase. use base 'My::Class'; - use Test2::Util::HashBase qw/bat/; + use Test2::Util::HashBase qw/bub/; sub init { my $self = shift; # We get the constants from the base class for free. $self->{+FOO} ||= 'SubFoo'; - $self->{+BAT} ||= 'bat'; + $self->{+BUB} ||= 'bub'; $self->SUPER::init(); } @@ -213,10 +227,13 @@ use it: my $two = My::Class->new({foo => 'MyFoo', bar => 'MyBar'}); my $three = My::Class->new(['MyFoo', 'MyBar']); - # Accessors! + # Readers! my $foo = $one->foo; # 'MyFoo' my $bar = $one->bar; # 'MyBar' my $baz = $one->baz; # Defaulted to: 'baz' + my $bat = $one->bat; # Defaulted to: 'bat' + # '>ban' means setter only, no reader + # '+boo' means no setter or reader, just the BOO constant # Setters! $one->set_foo('A Foo'); @@ -228,6 +245,9 @@ use it: # deprecated. $one->set_baz('A Baz'); + # '<bat' means no setter defined at all + # '+boo' means no setter or reader, just the BOO constant + $one->{+FOO} = 'xxx'; =head1 DESCRIPTION @@ -371,6 +391,24 @@ deprecated. =back +=head2 NO SETTER + + use Test2::Util::HashBase qw/<foo/; + +Only gives you a reader, no C<set_foo> method is defined at all. + +=head2 NO READER + + use Test2::Util::HashBase qw/>foo/; + +Only gives you a write (C<set_foo>), no C<foo> method is defined at all. + +=head2 CONSTANT ONLY + + use Test2::Util::HashBase qw/+foo/; + +This does not create any methods for you, it just adds the C<FOO> constant. + =head1 SUBCLASSING You can subclass an existing HashBase class. @@ -425,7 +463,7 @@ F<http://github.com/Test-More/HashBase/>. =head1 COPYRIGHT -Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>. +Copyright 2017 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/Trace.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Trace.pm index 28124f3406..33b3648789 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Trace.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Util/Trace.pm @@ -2,7 +2,7 @@ package Test2::Util::Trace; require Test2::EventFacet::Trace; @ISA = ('Test2::EventFacet::Trace'); -our $VERSION = '1.302162'; +our $VERSION = '1.302175'; 1; |