summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test2
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2021-03-03 11:04:20 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2021-03-03 11:04:20 +0000
commit13c3572d26e0868b9665513e4646ade860ae7810 (patch)
tree72f68d7c1270cc0a1d504f8eeb45d4de6b36f2d1 /Master/tlpkg/tlperl/lib/Test2
parent87d16a01498a53c4bb455d78ae7131370e47591e (diff)
Updated tlperl
git-svn-id: svn://tug.org/texlive/trunk@58075 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test2')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API.pm95
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Breakage.pm6
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Context.pm8
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Instance.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Stack.pm8
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event.pm6
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Bail.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Diag.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Encoding.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Exception.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/Event/Fail.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Generic.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Note.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Ok.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/Event/Pass.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Plan.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Skip.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Subtest.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/Event/V2.pm6
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Waiting.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/About.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/EventFacet/Info/Table.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Formatter.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm26
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub.pm6
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/IPC.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/IPC/Driver.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm28
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Transition.pod22
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm2
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util/HashBase.pm72
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util/Trace.pm2
51 files changed, 276 insertions, 96 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test2/API.pm b/Master/tlpkg/tlperl/lib/Test2/API.pm
index 8193b073661..6c517415bd9 100755
--- a/Master/tlpkg/tlperl/lib/Test2/API.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/API/Breakage.pm b/Master/tlpkg/tlperl/lib/Test2/API/Breakage.pm
index ffcf1be582f..2dd2852d0e0 100755
--- a/Master/tlpkg/tlperl/lib/Test2/API/Breakage.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/API/Context.pm b/Master/tlpkg/tlperl/lib/Test2/API/Context.pm
index 9cb1cfca723..177d9c40724 100755
--- a/Master/tlpkg/tlperl/lib/Test2/API/Context.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/API/Instance.pm b/Master/tlpkg/tlperl/lib/Test2/API/Instance.pm
index 1cf224cf063..fbbb675cc42 100755
--- a/Master/tlpkg/tlperl/lib/Test2/API/Instance.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm b/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm
index ffa4ed57f01..d6b6e85c86b 100755
--- a/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event.pm b/Master/tlpkg/tlperl/lib/Test2/Event.pm
index 598456c1dc3..e1c567a7396 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Bail.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Bail.pm
index 4fa83c4899b..076ac9761dd 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Bail.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Diag.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Diag.pm
index 86617f8afc7..9fa732ff4ff 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Diag.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Encoding.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Encoding.pm
index 12071637af5..3fb7364394a 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Encoding.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Exception.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Exception.pm
index 66bbdb4fb40..df83ac8714b 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Exception.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Fail.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Fail.pm
index 2577cd93381..f09a035ede9 100644
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Fail.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Generic.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Generic.pm
index 02619d9a171..ef08124a166 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Generic.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Note.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Note.pm
index 3dd09998445..4a310f3cd13 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Note.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Ok.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Ok.pm
index 7a603b40ca5..088c8b6d4dd 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Ok.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Pass.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Pass.pm
index 46726234304..bfc3a73b48b 100644
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Pass.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Plan.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Plan.pm
index 00b63970f7a..ad8f927552b 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Plan.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Skip.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Skip.pm
index 07db32932aa..a9923243551 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Skip.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
index 92e3f6dfa14..aed0c0061f4 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm b/Master/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm
index cf7d773e1f4..b3cb1d8558e 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/V2.pm b/Master/tlpkg/tlperl/lib/Test2/Event/V2.pm
index 020cf2348e6..326a818f1d8 100644
--- a/Master/tlpkg/tlperl/lib/Test2/Event/V2.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Event/Waiting.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Waiting.pm
index 4b790a6ff92..dbd1448584f 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Waiting.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet.pm
index d9fb03f4518..13c217f33fd 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/About.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/About.pm
index fc36d2766a8..f12ebf835a4 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/About.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm
index ac72cf3890c..45ed92703cd 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Amnesty.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm
index a11aef15691..02f89aff729 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Assert.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm
index 6ea0eaef404..8a04a4a3a55 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Control.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm
index 4a21ef7e286..87baf113fbd 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Error.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm
index 40b9d658026..370142577c3 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Hub.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm
index c382049480d..badd2d04573 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Info.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Info/Table.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Info/Table.pm
index 64bd95539a5..0c127b5a242 100755
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Info/Table.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm
index dc369ff2b1c..2b75764eb15 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Meta.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm
index d36fd92b27c..ac267379cf1 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Parent.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm
index 2f14f7d69e0..355588b5bc1 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Plan.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm
index 07c454365a2..13fe4cbc91f 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Render.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm b/Master/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm
index 34a3fce7ad0..455b0ee1166 100644
--- a/Master/tlpkg/tlperl/lib/Test2/EventFacet/Trace.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Formatter.pm b/Master/tlpkg/tlperl/lib/Test2/Formatter.pm
index c4515d8c41c..17c28bf2769 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Formatter.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm b/Master/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm
index 25961bf7370..120c82d77b9 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Hub.pm b/Master/tlpkg/tlperl/lib/Test2/Hub.pm
index a5706e56771..e041f6db73a 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Hub.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm b/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm
index cd459ada066..317dfa8c2ee 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm b/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm
index 6f44b08bcdd..906e7b0a037 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm b/Master/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm
index 52d5b4e0fa4..acc63696461 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/IPC.pm b/Master/tlpkg/tlperl/lib/Test2/IPC.pm
index b2a503bfa74..e9d29cca25f 100755
--- a/Master/tlpkg/tlperl/lib/Test2/IPC.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/IPC/Driver.pm b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver.pm
index dbcb7004b3f..db6642a564a 100755
--- a/Master/tlpkg/tlperl/lib/Test2/IPC/Driver.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm
index f6d7ff1b2c0..09fdd5c0cf6 100755
--- a/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm b/Master/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm
index 4da76a79ba4..5139e4607c7 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Transition.pod b/Master/tlpkg/tlperl/lib/Test2/Transition.pod
index de6442ce610..07811f0d629 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Transition.pod
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Util.pm b/Master/tlpkg/tlperl/lib/Test2/Util.pm
index c4a865e9b15..0ba499557a0 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Util.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm b/Master/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm
index dbd819feeaf..90345d0ecd4 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm b/Master/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm
index 812282d157a..4bcee18112e 100644
--- a/Master/tlpkg/tlperl/lib/Test2/Util/Facets2Legacy.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm b/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm
index c34db5fc565..a6a04f9bee1 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm
+++ b/Master/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/Master/tlpkg/tlperl/lib/Test2/Util/Trace.pm b/Master/tlpkg/tlperl/lib/Test2/Util/Trace.pm
index 28124f3406c..33b3648789b 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Util/Trace.pm
+++ b/Master/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;