summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test2
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2018-03-08 00:16:42 +0000
committerKarl Berry <karl@freefriends.org>2018-03-08 00:16:42 +0000
commit34a8597760ab5740abd49b6d8be10e1876f5ce98 (patch)
tree099a794912a28b3ebbc857961643ba29b28e674a /Master/tlpkg/tlperl/lib/Test2
parent2ca3610031316a7312d046d3ae4c783452831216 (diff)
(tl)perl 5.26.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@46882 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test2')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API.pm1310
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Breakage.pm175
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Context.pm739
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Instance.pm754
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/API/Stack.pm220
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event.pm254
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Bail.pm102
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Diag.pm83
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Encoding.pm86
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Exception.pm88
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Generic.pm263
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Info.pm127
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Note.pm81
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Ok.pm140
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Plan.pm160
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Skip.pm108
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Subtest.pm131
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm83
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Waiting.pm61
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Formatter.pm128
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm538
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub.pm829
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm80
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm51
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm125
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/IPC.pm140
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/IPC/Driver.pm292
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm497
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm425
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Transition.pod512
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util.pm258
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm182
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util/HashBase.pm289
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util/Trace.pm186
34 files changed, 9497 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test2/API.pm b/Master/tlpkg/tlperl/lib/Test2/API.pm
new file mode 100755
index 00000000000..41cd0af209e
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/API.pm
@@ -0,0 +1,1310 @@
+package Test2::API;
+use strict;
+use warnings;
+
+BEGIN {
+ $ENV{TEST_ACTIVE} ||= 1;
+ $ENV{TEST2_ACTIVE} = 1;
+}
+
+our $VERSION = '1.302073';
+
+
+my $INST;
+my $ENDING = 0;
+sub test2_set_is_end { ($ENDING) = @_ ? @_ : (1) }
+sub test2_get_is_end { $ENDING }
+
+use Test2::API::Instance(\$INST);
+# Set the exit status
+END {
+ test2_set_is_end(); # See gh #16
+ $INST->set_exit();
+}
+
+# See gh #16
+{
+ no warnings;
+ INIT { eval 'END { test2_set_is_end() }; 1' or die $@ }
+}
+
+BEGIN {
+ no warnings 'once';
+ if($] ge '5.014' || $ENV{T2_CHECK_DEPTH} || $Test2::API::DO_DEPTH_CHECK) {
+ *DO_DEPTH_CHECK = sub() { 1 };
+ }
+ else {
+ *DO_DEPTH_CHECK = sub() { 0 };
+ }
+}
+
+use Test2::Util::Trace();
+
+use Test2::Hub::Subtest();
+use Test2::Hub::Interceptor();
+use Test2::Hub::Interceptor::Terminator();
+
+use Test2::Event::Ok();
+use Test2::Event::Diag();
+use Test2::Event::Note();
+use Test2::Event::Plan();
+use Test2::Event::Bail();
+use Test2::Event::Exception();
+use Test2::Event::Waiting();
+use Test2::Event::Skip();
+use Test2::Event::Subtest();
+
+use Carp qw/carp croak confess longmess/;
+use Scalar::Util qw/blessed weaken/;
+use Test2::Util qw/get_tid/;
+
+our @EXPORT_OK = qw{
+ context release
+ context_do
+ no_context
+ intercept
+ run_subtest
+
+ test2_init_done
+ test2_load_done
+
+ test2_set_is_end
+ test2_get_is_end
+
+ test2_pid
+ test2_tid
+ test2_stack
+ test2_no_wait
+
+ test2_add_callback_context_aquire
+ test2_add_callback_context_acquire
+ test2_add_callback_context_init
+ test2_add_callback_context_release
+ test2_add_callback_exit
+ test2_add_callback_post_load
+ test2_list_context_aquire_callbacks
+ test2_list_context_acquire_callbacks
+ test2_list_context_init_callbacks
+ test2_list_context_release_callbacks
+ test2_list_exit_callbacks
+ test2_list_post_load_callbacks
+
+ test2_ipc
+ test2_ipc_drivers
+ test2_ipc_add_driver
+ test2_ipc_polling
+ test2_ipc_disable_polling
+ test2_ipc_enable_polling
+ test2_ipc_get_pending
+ test2_ipc_set_pending
+ test2_ipc_enable_shm
+
+ test2_formatter
+ test2_formatters
+ test2_formatter_add
+ test2_formatter_set
+};
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
+
+my $STACK = $INST->stack;
+my $CONTEXTS = $INST->contexts;
+my $INIT_CBS = $INST->context_init_callbacks;
+my $ACQUIRE_CBS = $INST->context_acquire_callbacks;
+
+sub test2_init_done { $INST->finalized }
+sub test2_load_done { $INST->loaded }
+
+sub test2_pid { $INST->pid }
+sub test2_tid { $INST->tid }
+sub test2_stack { $INST->stack }
+sub test2_no_wait {
+ $INST->set_no_wait(@_) if @_;
+ $INST->no_wait;
+}
+
+sub test2_add_callback_context_acquire { $INST->add_context_acquire_callback(@_) }
+sub test2_add_callback_context_aquire { $INST->add_context_acquire_callback(@_) }
+sub test2_add_callback_context_init { $INST->add_context_init_callback(@_) }
+sub test2_add_callback_context_release { $INST->add_context_release_callback(@_) }
+sub test2_add_callback_exit { $INST->add_exit_callback(@_) }
+sub test2_add_callback_post_load { $INST->add_post_load_callback(@_) }
+sub test2_list_context_aquire_callbacks { @{$INST->context_acquire_callbacks} }
+sub test2_list_context_acquire_callbacks { @{$INST->context_acquire_callbacks} }
+sub test2_list_context_init_callbacks { @{$INST->context_init_callbacks} }
+sub test2_list_context_release_callbacks { @{$INST->context_release_callbacks} }
+sub test2_list_exit_callbacks { @{$INST->exit_callbacks} }
+sub test2_list_post_load_callbacks { @{$INST->post_load_callbacks} }
+
+sub test2_ipc { $INST->ipc }
+sub test2_ipc_add_driver { $INST->add_ipc_driver(@_) }
+sub test2_ipc_drivers { @{$INST->ipc_drivers} }
+sub test2_ipc_polling { $INST->ipc_polling }
+sub test2_ipc_enable_polling { $INST->enable_ipc_polling }
+sub test2_ipc_disable_polling { $INST->disable_ipc_polling }
+sub test2_ipc_get_pending { $INST->get_ipc_pending }
+sub test2_ipc_set_pending { $INST->set_ipc_pending(@_) }
+sub test2_ipc_enable_shm { $INST->ipc_enable_shm }
+
+sub test2_formatter { $INST->formatter }
+sub test2_formatters { @{$INST->formatters} }
+sub test2_formatter_add { $INST->add_formatter(@_) }
+sub test2_formatter_set {
+ my ($formatter) = @_;
+ croak "No formatter specified" unless $formatter;
+ croak "Global Formatter already set" if $INST->formatter_set;
+ $INST->set_formatter($formatter);
+}
+
+# Private, for use in Test2::API::Context
+sub _contexts_ref { $INST->contexts }
+sub _context_acquire_callbacks_ref { $INST->context_acquire_callbacks }
+sub _context_init_callbacks_ref { $INST->context_init_callbacks }
+sub _context_release_callbacks_ref { $INST->context_release_callbacks }
+
+# Private, for use in Test2::IPC
+sub _set_ipc { $INST->set_ipc(@_) }
+
+sub context_do(&;@) {
+ my $code = shift;
+ my @args = @_;
+
+ my $ctx = context(level => 1);
+
+ my $want = wantarray;
+
+ my @out;
+ my $ok = eval {
+ $want ? @out = $code->($ctx, @args) :
+ defined($want) ? $out[0] = $code->($ctx, @args) :
+ $code->($ctx, @args) ;
+ 1;
+ };
+ my $err = $@;
+
+ $ctx->release;
+
+ die $err unless $ok;
+
+ return @out if $want;
+ return $out[0] if defined $want;
+ return;
+}
+
+sub no_context(&;$) {
+ my ($code, $hid) = @_;
+ $hid ||= $STACK->top->hid;
+
+ my $ctx = $CONTEXTS->{$hid};
+ delete $CONTEXTS->{$hid};
+ my $ok = eval { $code->(); 1 };
+ my $err = $@;
+
+ $CONTEXTS->{$hid} = $ctx;
+ weaken($CONTEXTS->{$hid});
+
+ die $err unless $ok;
+
+ return;
+};
+
+sub context {
+ # We need to grab these before anything else to ensure they are not
+ # changed.
+ my ($errno, $eval_error, $child_error) = (0 + $!, $@, $?);
+
+ my %params = (level => 0, wrapped => 0, @_);
+
+ # If something is getting a context then the sync system needs to be
+ # considered loaded...
+ $INST->load unless $INST->{loaded};
+
+ croak "context() called, but return value is ignored"
+ unless defined wantarray;
+
+ my $stack = $params{stack} || $STACK;
+ my $hub = $params{hub} || (@$stack ? $stack->[-1] : $stack->top);
+ my $hid = $hub->{hid};
+ my $current = $CONTEXTS->{$hid};
+
+ $_->(\%params) for @$ACQUIRE_CBS;
+ map $_->(\%params), @{$hub->{_context_acquire}} if $hub->{_context_acquire};
+
+ # This is for https://github.com/Test-More/test-more/issues/16
+ # and https://rt.perl.org/Public/Bug/Display.html?id=127774
+ my $phase = ${^GLOBAL_PHASE} || 'NA';
+ 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);
+ 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);
+ }
+
+ my $depth = $level;
+ $depth++ while DO_DEPTH_CHECK && !$end_phase && (!$current || $depth <= $current->{_depth} + $params{wrapped}) && caller($depth + 1);
+ $depth -= $params{wrapped};
+ my $depth_ok = !DO_DEPTH_CHECK || $end_phase || !$current || $current->{_depth} < $depth;
+
+ if ($current && $params{on_release} && $depth_ok) {
+ $current->{_on_release} ||= [];
+ push @{$current->{_on_release}} => $params{on_release};
+ }
+
+ # I know this is ugly....
+ ($!, $@, $?) = ($errno, $eval_error, $child_error) and return bless(
+ {
+ %$current,
+ _is_canon => undef,
+ errno => $errno,
+ eval_error => $eval_error,
+ child_error => $child_error,
+ _is_spawn => [$pkg, $file, $line, $sub],
+ },
+ 'Test2::API::Context'
+ ) if $current && $depth_ok;
+
+ # Handle error condition of bad level
+ if ($current) {
+ unless (${$current->{_aborted}}) {
+ _canon_error($current, [$pkg, $file, $line, $sub, $depth])
+ unless $current->{_is_canon};
+
+ _depth_error($current, [$pkg, $file, $line, $sub, $depth])
+ unless $depth_ok;
+ }
+
+ $current->release if $current->{_is_canon};
+
+ delete $CONTEXTS->{$hid};
+ }
+
+ # Directly bless the object here, calling new is a noticeable performance
+ # hit with how often this needs to be called.
+ my $trace = bless(
+ {
+ frame => [$pkg, $file, $line, $sub],
+ pid => $$,
+ tid => get_tid(),
+ },
+ 'Test2::Util::Trace'
+ );
+
+ # Directly bless the object here, calling new is a noticeable performance
+ # hit with how often this needs to be called.
+ my $aborted = 0;
+ $current = bless(
+ {
+ _aborted => \$aborted,
+ stack => $stack,
+ hub => $hub,
+ trace => $trace,
+ _is_canon => 1,
+ _depth => $depth,
+ errno => $errno,
+ eval_error => $eval_error,
+ child_error => $child_error,
+ $params{on_release} ? (_on_release => [$params{on_release}]) : (),
+ },
+ 'Test2::API::Context'
+ );
+
+ $CONTEXTS->{$hid} = $current;
+ weaken($CONTEXTS->{$hid});
+
+ $_->($current) for @$INIT_CBS;
+ map $_->($current), @{$hub->{_context_init}} if $hub->{_context_init};
+
+ $params{on_init}->($current) if $params{on_init};
+
+ ($!, $@, $?) = ($errno, $eval_error, $child_error);
+
+ return $current;
+}
+
+sub _depth_error {
+ _existing_error(@_, <<" EOT");
+context() was called to retrieve an existing context, however the existing
+context was created in a stack frame at the same, or deeper level. This usually
+means that a tool failed to release the context when it was finished.
+ EOT
+}
+
+sub _canon_error {
+ _existing_error(@_, <<" EOT");
+context() was called to retrieve an existing context, however the existing
+context has an invalid internal state (!_canon_count). This should not normally
+happen unless something is mucking about with internals...
+ EOT
+}
+
+sub _existing_error {
+ my ($ctx, $details, $msg) = @_;
+ my ($pkg, $file, $line, $sub, $depth) = @$details;
+
+ my $oldframe = $ctx->{trace}->frame;
+ my $olddepth = $ctx->{_depth};
+
+ my $mess = longmess();
+
+ warn <<" EOT";
+$msg
+Old context details:
+ File: $oldframe->[1]
+ Line: $oldframe->[2]
+ Tool: $oldframe->[3]
+ Depth: $olddepth
+
+New context details:
+ File: $file
+ Line: $line
+ Tool: $sub
+ Depth: $depth
+
+Trace: $mess
+
+Removing the old context and creating a new one...
+ EOT
+}
+
+sub release($;$) {
+ $_[0]->release;
+ return $_[1];
+}
+
+sub intercept(&) {
+ my $code = shift;
+
+ my $ctx = context();
+
+ my $ipc;
+ if (my $global_ipc = test2_ipc()) {
+ my $driver = blessed($global_ipc);
+ $ipc = $driver->new;
+ }
+
+ my $hub = Test2::Hub::Interceptor->new(
+ ipc => $ipc,
+ no_ending => 1,
+ );
+
+ my @events;
+ $hub->listen(sub { push @events => $_[1] });
+
+ $ctx->stack->top; # Make sure there is a top hub before we begin.
+ $ctx->stack->push($hub);
+
+ my ($ok, $err) = (1, undef);
+ T2_SUBTEST_WRAPPER: {
+ # Do not use 'try' cause it localizes __DIE__
+ $ok = eval { $code->(hub => $hub, context => $ctx->snapshot); 1 };
+ $err = $@;
+
+ # They might have done 'BEGIN { skip_all => "whatever" }'
+ if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && $err->isa('Test2::Hub::Interceptor::Terminator'))) {
+ $ok = 1;
+ $err = undef;
+ }
+ }
+
+ $hub->cull;
+ $ctx->stack->pop($hub);
+
+ my $trace = $ctx->trace;
+ $ctx->release;
+
+ die $err unless $ok;
+
+ $hub->finalize($trace, 1)
+ if $ok
+ && !$hub->no_ending
+ && !$hub->ended;
+
+ return \@events;
+}
+
+sub run_subtest {
+ my ($name, $code, $params, @args) = @_;
+
+ $params = {buffered => $params} unless ref $params;
+ my $buffered = delete $params->{buffered};
+ my $inherit_trace = delete $params->{inherit_trace};
+
+ my $ctx = context();
+
+ $ctx->note($name) unless $buffered;
+
+ my $parent = $ctx->hub;
+
+ my $stack = $ctx->stack || $STACK;
+ my $hub = $stack->new_hub(
+ class => 'Test2::Hub::Subtest',
+ %$params,
+ );
+
+ my @events;
+ $hub->set_nested( $parent->isa('Test2::Hub::Subtest') ? $parent->nested + 1 : 1 );
+ $hub->listen(sub { push @events => $_[1] });
+
+ if ($buffered) {
+ if (my $format = $hub->format) {
+ my $hide = $format->can('hide_buffered') ? $format->hide_buffered : 1;
+ $hub->format(undef) if $hide;
+ }
+ }
+ elsif (! $parent->format) {
+ # If our parent has no format that means we're in a buffered subtest
+ # and now we're trying to run a streaming subtest. There's really no
+ # way for that to work, so we need to force the use of a buffered
+ # subtest here as
+ # well. https://github.com/Test-More/test-more/issues/721
+ $buffered = 1;
+ }
+
+ if ($inherit_trace) {
+ my $orig = $code;
+ $code = sub {
+ my $st_ctx = Test2::API::Context->new(
+ trace => $ctx->trace,
+ hub => $hub,
+ );
+ $st_ctx->do_in_context($orig, @args);
+ };
+ }
+
+ my ($ok, $err, $finished);
+ T2_SUBTEST_WRAPPER: {
+ # Do not use 'try' cause it localizes __DIE__
+ $ok = eval { $code->(@args); 1 };
+ $err = $@;
+
+ # They might have done 'BEGIN { skip_all => "whatever" }'
+ if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) {
+ $ok = undef;
+ $err = undef;
+ }
+ else {
+ $finished = 1;
+ }
+ }
+ $stack->pop($hub);
+
+ my $trace = $ctx->trace;
+
+ if (!$finished) {
+ if(my $bailed = $hub->bailed_out) {
+ $ctx->bail($bailed->reason);
+ }
+ my $code = $hub->exit_code;
+ $ok = !$code;
+ $err = "Subtest ended with exit code $code" if $code;
+ }
+
+ $hub->finalize($trace, 1)
+ if $ok
+ && !$hub->no_ending
+ && !$hub->ended;
+
+ my $pass = $ok && $hub->is_passing;
+ my $e = $ctx->build_event(
+ 'Subtest',
+ pass => $pass,
+ name => $name,
+ subtest_id => $hub->id,
+ buffered => $buffered,
+ subevents => \@events,
+ );
+
+ my $plan_ok = $hub->check_plan;
+
+ $ctx->hub->send($e);
+
+ $ctx->failure_diag($e) unless $e->pass;
+
+ $ctx->diag("Caught exception in subtest: $err") unless $ok;
+
+ $ctx->diag("Bad subtest plan, expected " . $hub->plan . " but ran " . $hub->count)
+ if defined($plan_ok) && !$plan_ok;
+
+ $ctx->release;
+ return $pass;
+}
+
+# There is a use-cycle between API and API/Context. Context needs to use some
+# API functions as the package is compiling. Test2::API::context() needs
+# Test2::API::Context to be loaded, but we cannot 'require' the module there as
+# it causes a very noticeable performance impact with how often context() is
+# called.
+require Test2::API::Context;
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API - Primary interface for writing Test2 based testing tools.
+
+=head1 ***INTERNALS NOTE***
+
+B<The internals of this package are subject to change at any time!> The public
+methods provided will not change in backwards-incompatible ways (once there is
+a stable release), but the underlying implementation details might.
+B<Do not break encapsulation here!>
+
+Currently the implementation is to create a single instance of the
+L<Test2::API::Instance> Object. All class methods defer to the single
+instance. There is no public access to the singleton, and that is intentional.
+The class methods provided by this package provide the only functionality
+publicly exposed.
+
+This is done primarily to avoid the problems Test::Builder had by exposing its
+singleton. We do not want anyone to replace this singleton, rebless it, or
+directly muck with its internals. If you need to do something and cannot
+because of the restrictions placed here, then please report it as an issue. If
+possible, we will create a way for you to implement your functionality without
+exposing things that should not be exposed.
+
+=head1 DESCRIPTION
+
+This package exports all the functions necessary to write and/or verify testing
+tools. Using these building blocks you can begin writing test tools very
+quickly. You are also provided with tools that help you to test the tools you
+write.
+
+=head1 SYNOPSIS
+
+=head2 WRITING A TOOL
+
+The C<context()> method is your primary interface into the Test2 framework.
+
+ package My::Ok;
+ use Test2::API qw/context/;
+
+ our @EXPORT = qw/my_ok/;
+ use base 'Exporter';
+
+ # Just like ok() from Test::More
+ sub my_ok($;$) {
+ my ($bool, $name) = @_;
+ my $ctx = context(); # Get a context
+ $ctx->ok($bool, $name);
+ $ctx->release; # Release the context
+ return $bool;
+ }
+
+See L<Test2::API::Context> for a list of methods available on the context object.
+
+=head2 TESTING YOUR TOOLS
+
+The C<intercept { ... }> tool lets you temporarily intercept all events
+generated by the test system:
+
+ use Test2::API qw/intercept/;
+
+ use My::Ok qw/my_ok/;
+
+ my $events = intercept {
+ # These events are not displayed
+ my_ok(1, "pass");
+ 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");
+
+=head2 OTHER API FUNCTIONS
+
+ use Test2::API qw{
+ test2_init_done
+ test2_stack
+ test2_set_is_end
+ test2_get_is_end
+ test2_ipc
+ test2_formatter_set
+ test2_formatter
+ };
+
+ my $init = test2_init_done();
+ my $stack = test2_stack();
+ my $ipc = test2_ipc();
+
+ test2_formatter_set($FORMATTER)
+ my $formatter = test2_formatter();
+
+ ... And others ...
+
+=head1 MAIN API EXPORTS
+
+All exports are optional. You must specify subs to import.
+
+ use Test2::API qw/context intercept run_subtest/;
+
+This is the list of exports that are most commonly needed. If you are simply
+writing a tool, then this is probably all you need. If you need something and
+you cannot find it here, then you can also look at L</OTHER API EXPORTS>.
+
+These exports lack the 'test2_' prefix because of how important/common they
+are. Exports in the L</OTHER API EXPORTS> section have the 'test2_' prefix to
+ensure they stand out.
+
+=head2 context(...)
+
+Usage:
+
+=over 4
+
+=item $ctx = context()
+
+=item $ctx = context(%params)
+
+=back
+
+The C<context()> function will always return the current context. If
+there is already a context active, it will be returned. If there is not an
+active context, one will be generated. When a context is generated it will
+default to using the file and line number where the currently running sub was
+called from.
+
+Please see L<Test2::API::Context/"CRITICAL DETAILS"> for important rules about
+what you can and cannot do with a context once it is obtained.
+
+B<Note> This function will throw an exception if you ignore the context object
+it returns.
+
+B<Note> On perls 5.14+ a depth check is used to insure there are no context
+leaks. This cannot be safely done on older perls due to
+L<https://rt.perl.org/Public/Bug/Display.html?id=127774>
+You can forcefully enable it either by setting C<$ENV{T2_CHECK_DEPTH} = 1> or
+C<$Test2::API::DO_DEPTH_CHECK = 1> B<BEFORE> loading L<Test2::API>.
+
+=head3 OPTIONAL PARAMETERS
+
+All parameters to C<context> are optional.
+
+=over 4
+
+=item level => $int
+
+If you must obtain a context in a sub deeper than your entry point you can use
+this to tell it how many EXTRA stack frames to look back. If this option is not
+provided the default of C<0> is used.
+
+ sub third_party_tool {
+ my $sub = shift;
+ ... # Does not obtain a context
+ $sub->();
+ ...
+ }
+
+ third_party_tool(sub {
+ my $ctx = context(level => 1);
+ ...
+ $ctx->release;
+ });
+
+=item wrapped => $int
+
+Use this if you need to write your own tool that wraps a call to C<context()>
+with the intent that it should return a context object.
+
+ sub my_context {
+ my %params = ( wrapped => 0, @_ );
+ $params{wrapped}++;
+ my $ctx = context(%params);
+ ...
+ return $ctx;
+ }
+
+ sub my_tool {
+ my $ctx = my_context();
+ ...
+ $ctx->release;
+ }
+
+If you do not do this, then tools you call that also check for a context will
+notice that the context they grabbed was created at the same stack depth, which
+will trigger protective measures that warn you and destroy the existing
+context.
+
+=item stack => $stack
+
+Normally C<context()> looks at the global hub stack. If you are maintaining
+your own L<Test2::API::Stack> instance you may pass it in to be used
+instead of the global one.
+
+=item hub => $hub
+
+Use this parameter if you want to obtain the context for a specific hub instead
+of whatever one happens to be at the top of the stack.
+
+=item on_init => sub { ... }
+
+This lets you provide a callback sub that will be called B<ONLY> if your call
+to C<context()> generated a new context. The callback B<WILL NOT> be called if
+C<context()> is returning an existing context. The only argument passed into
+the callback will be the context object itself.
+
+ sub foo {
+ my $ctx = context(on_init => sub { 'will run' });
+
+ my $inner = sub {
+ # This callback is not run since we are getting the existing
+ # context from our parent sub.
+ my $ctx = context(on_init => sub { 'will NOT run' });
+ $ctx->release;
+ }
+ $inner->();
+
+ $ctx->release;
+ }
+
+=item on_release => sub { ... }
+
+This lets you provide a callback sub that will be called when the context
+instance is released. This callback will be added to the returned context even
+if an existing context is returned. If multiple calls to context add callbacks,
+then all will be called in reverse order when the context is finally released.
+
+ sub foo {
+ my $ctx = context(on_release => sub { 'will run second' });
+
+ my $inner = sub {
+ my $ctx = context(on_release => sub { 'will run first' });
+
+ # Neither callback runs on this release
+ $ctx->release;
+ }
+ $inner->();
+
+ # Both callbacks run here.
+ $ctx->release;
+ }
+
+=back
+
+=head2 release($;$)
+
+Usage:
+
+=over 4
+
+=item release $ctx;
+
+=item release $ctx, ...;
+
+=back
+
+This is intended as a shortcut that lets you release your context and return a
+value in one statement. This function will get your context, and an optional
+return value. It will release your context, then return your value. Scalar
+context is always assumed.
+
+ sub tool {
+ my $ctx = context();
+ ...
+
+ return release $ctx, 1;
+ }
+
+This tool is most useful when you want to return the value you get from calling
+a function that needs to see the current context:
+
+ my $ctx = context();
+ my $out = some_tool(...);
+ $ctx->release;
+ return $out;
+
+We can combine the last 3 lines of the above like so:
+
+ my $ctx = context();
+ release $ctx, some_tool(...);
+
+=head2 context_do(&;@)
+
+Usage:
+
+ sub my_tool {
+ context_do {
+ my $ctx = shift;
+
+ my (@args) = @_;
+
+ $ctx->ok(1, "pass");
+
+ ...
+
+ # No need to call $ctx->release, done for you on scope exit.
+ } @_;
+ }
+
+Using this inside your test tool takes care of a lot of boilerplate for you. It
+will ensure a context is acquired. It will capture and rethrow any exception. It
+will insure the context is released when you are done. It preserves the
+subroutine call context (array, scalar, void).
+
+This is the safest way to write a test tool. The only two downsides to this are a
+slight performance decrease, and some extra indentation in your source. If the
+indentation is a problem for you then you can take a peek at the next section.
+
+=head2 no_context(&;$)
+
+Usage:
+
+=over 4
+
+=item no_context { ... };
+
+=item no_context { ... } $hid;
+
+ sub my_tool(&) {
+ my $code = shift;
+ my $ctx = context();
+ ...
+
+ no_context {
+ # Things in here will not see our current context, they get a new
+ # one.
+
+ $code->();
+ };
+
+ ...
+ $ctx->release;
+ };
+
+=back
+
+This tool will hide a context for the provided block of code. This means any
+tools run inside the block will get a completely new context if they acquire
+one. The new context will be inherited by tools nested below the one that
+acquired it.
+
+This will normally hide the current context for the top hub. If you need to
+hide the context for a different hub you can pass in the optional C<$hid>
+parameter.
+
+=head2 intercept(&)
+
+Usage:
+
+ my $events = intercept {
+ ok(1, "pass");
+ ok(0, "fail");
+ ...
+ };
+
+This function takes a codeblock as its only argument, and it has a prototype.
+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.
+
+=head2 run_subtest(...)
+
+Usage:
+
+ run_subtest($NAME, \&CODE, $BUFFERED, @ARGS)
+
+ # or
+
+ run_subtest($NAME, \&CODE, \%PARAMS, @ARGS)
+
+This will run the provided codeblock with the args in C<@args>. This codeblock
+will be run as a subtest. A subtest is an isolated test state that is condensed
+into a single L<Test2::Event::Subtest> event, which contains all events
+generated inside the subtest.
+
+=head3 ARGUMENTS:
+
+=over 4
+
+=item $NAME
+
+The name of the subtest.
+
+=item \&CODE
+
+The code to run inside the subtest.
+
+=item $BUFFERED or \%PARAMS
+
+If this is a simple scalar then it will be treated as a boolean for the
+'buffered' setting. If this is a hash reference then it will be used as a
+parameters hash. The param hash will be used for hub construction (with the
+specified keys removed).
+
+Keys that are removed and used by run_subtest:
+
+=over 4
+
+=item 'buffered' => $bool
+
+Toggle buffered status.
+
+=item 'inherit_trace' => $bool
+
+Normally the subtest hub is pushed and the sub is allowed to generate its own
+root context for the hub. When this setting is turned on a root context will be
+created for the hub that shares the same trace as the current context.
+
+Set this to true if your tool is producing subtests without user-specified
+subs.
+
+=back
+
+=item @ARGS
+
+Any extra arguments you want passed into the subtest code.
+
+=back
+
+=head3 BUFFERED VS UNBUFFERED (OR STREAMED)
+
+Normally all events inside and outside a subtest are sent to the formatter
+immediately by the hub. Sometimes it is desirable to hold off sending events
+within a subtest until the subtest is complete. This usually depends on the
+formatter being used.
+
+=over 4
+
+=item Things not effected by this flag
+
+In both cases events are generated and stored in an array. This array is
+eventually used to populate the C<subevents> attribute on the
+L<Test2::Event::Subtest> event that is generated at the end of the subtest.
+This flag has no effect on this part, it always happens.
+
+At the end of the subtest, the final L<Test2::Event::Subtest> event is sent to
+the formatter.
+
+=item Things that are effected by this flag
+
+The C<buffered> attribute of the L<Test2::Event::Subtest> event will be set to
+the value of this flag. This means any formatter, listener, etc which looks at
+the event will know if it was buffered.
+
+=item Things that are formatter dependant
+
+Events within a buffered subtest may or may not be sent to the formatter as
+they happen. If a formatter fails to specify then the default is to B<NOT SEND>
+the events as they are generated, instead the formatter can pull them from the
+C<subevents> attribute.
+
+A formatter can specify by implementing the C<hide_buffered()> method. If this
+method returns true then events generated inside a buffered subtest will not be
+sent independently of the final subtest event.
+
+=back
+
+An example of how this is used is the L<Test2::Formatter::TAP> formatter. For
+unbuffered subtests the events are rendered as they are generated. At the end
+of the subtest, the final subtest event is rendered, but the C<subevents>
+attribute is ignored. For buffered subtests the opposite occurs, the events are
+NOT rendered as they are generated, instead the C<subevents> attribute is used
+to render them all at once. This is useful when running subtests tests in
+parallel, since without it the output from subtests would be interleaved
+together.
+
+=head1 OTHER API EXPORTS
+
+Exports in this section are not commonly needed. These all have the 'test2_'
+prefix to help ensure they stand out. You should look at the L</MAIN API
+EXPORTS> section before looking here. This section is one where "Great power
+comes with great responsibility". It is possible to break things badly if you
+are not careful with these.
+
+All exports are optional. You need to list which ones you want at import time:
+
+ use Test2::API qw/test2_init_done .../;
+
+=head2 STATUS AND INITIALIZATION STATE
+
+These provide access to internal state and object instances.
+
+=over 4
+
+=item $bool = test2_init_done()
+
+This will return true if the stack and IPC instances have already been
+initialized. It will return false if they have not. Init happens as late as
+possible. It happens as soon as a tool requests the IPC instance, the
+formatter, or the stack.
+
+=item $bool = test2_load_done()
+
+This will simply return the boolean value of the loaded flag. If Test2 has
+finished loading this will be true, otherwise false. Loading is considered
+complete the first time a tool requests a context.
+
+=item test2_set_is_end()
+
+=item test2_set_is_end($bool)
+
+This is used to toggle Test2's belief that the END phase has already started.
+With no arguments this will set it to true. With arguments it will set it to
+the first argument's value.
+
+This is used to prevent the use of C<caller()> in END blocks which can cause
+segfaults. This is only necessary in some persistent environments that may have
+multiple END phases.
+
+=item $bool = test2_get_is_end()
+
+Check if Test2 believes it is the END phase.
+
+=item $stack = test2_stack()
+
+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_no_wait()
+
+=item test2_no_wait($bool)
+
+This can be used to get/set the no_wait status. Waiting is turned on by
+default. Waiting will cause the parent process/thread to wait until all child
+processes and threads are finished before exiting. You will almost never want
+to turn this off.
+
+=back
+
+=head2 BEHAVIOR HOOKS
+
+These are hooks that allow you to add custom behavior to actions taken by Test2
+and tools built on top of it.
+
+=over 4
+
+=item test2_add_callback_exit(sub { ... })
+
+This can be used to add a callback that is called after all testing is done. This
+is too late to add additional results, the main use of this callback is to set the
+exit code.
+
+ test2_add_callback_exit(
+ sub {
+ my ($context, $exit, \$new_exit) = @_;
+ ...
+ }
+ );
+
+The C<$context> passed in will be an instance of L<Test2::API::Context>. The
+C<$exit> argument will be the original exit code before anything modified it.
+C<$$new_exit> is a reference to the new exit code. You may modify this to
+change the exit code. Please note that C<$$new_exit> may already be different
+from C<$exit>
+
+=item test2_add_callback_post_load(sub { ... })
+
+Add a callback that will be called when Test2 is finished loading. This
+means the callback will be run once, the first time a context is obtained.
+If Test2 has already finished loading then the callback will be run immediately.
+
+=item test2_add_callback_context_acquire(sub { ... })
+
+Add a callback that will be called every time someone tries to acquire a
+context. This will be called on EVERY call to C<context()>. It gets a single
+argument, a reference to the hash of parameters being used the construct the
+context. This is your chance to change the parameters by directly altering the
+hash.
+
+ test2_add_callback_context_acquire(sub {
+ my $params = shift;
+ $params->{level}++;
+ });
+
+This is a very scary API function. Please do not use this unless you need to.
+This is here for L<Test::Builder> and backwards compatibility. This has you
+directly manipulate the hash instead of returning a new one for performance
+reasons.
+
+=item test2_add_callback_context_init(sub { ... })
+
+Add a callback that will be called every time a new context is created. The
+callback will receive the newly created context as its only argument.
+
+=item test2_add_callback_context_release(sub { ... })
+
+Add a callback that will be called every time a context is released. The
+callback will receive the released context as its only argument.
+
+=item @list = test2_list_context_acquire_callbacks()
+
+Return all the context acquire callback references.
+
+=item @list = test2_list_context_init_callbacks()
+
+Returns all the context init callback references.
+
+=item @list = test2_list_context_release_callbacks()
+
+Returns all the context release callback references.
+
+=item @list = test2_list_exit_callbacks()
+
+Returns all the exit callback references.
+
+=item @list = test2_list_post_load_callbacks()
+
+Returns all the post load callback references.
+
+=back
+
+=head2 IPC AND CONCURRENCY
+
+These let you access, or specify, the IPC system internals.
+
+=over 4
+
+=item $ipc = test2_ipc()
+
+This will return the global L<Test2::IPC::Driver> instance. If this has not yet
+been initialized it will be initialized now.
+
+=item test2_ipc_add_driver($DRIVER)
+
+Add an IPC driver to the list. This will add the driver to the start of the
+list.
+
+=item @drivers = test2_ipc_drivers()
+
+Get the list of IPC drivers.
+
+=item $bool = test2_ipc_polling()
+
+Check if polling is enabled.
+
+=item test2_ipc_enable_polling()
+
+Turn on polling. This will cull events from other processes and threads every
+time a context is created.
+
+=item test2_ipc_disable_polling()
+
+Turn off IPC polling.
+
+=item test2_ipc_enable_shm()
+
+Turn on IPC SHM. Only some IPC drivers use this, and most will turn it on
+themselves.
+
+=item test2_ipc_set_pending($uniq_val)
+
+Tell other processes and events that an event is pending. C<$uniq_val> should
+be a unique value no other thread/process will generate.
+
+B<Note:> After calling this C<test2_ipc_get_pending()> will return 1. This is
+intentional, and not avoidable.
+
+=item $pending = test2_ipc_get_pending()
+
+This returns -1 if there is no way to check (assume yes)
+
+This returns 0 if there are (most likely) no pending events.
+
+This returns 1 if there are (likely) pending events. Upon return it will reset,
+nothing else will be able to see that there were pending events.
+
+=back
+
+=head2 MANAGING FORMATTERS
+
+These let you access, or specify, the formatters that can/should be used.
+
+=over 4
+
+=item $formatter = test2_formatter
+
+This will return the global formatter class. This is not an instance. By
+default the formatter is set to L<Test2::Formatter::TAP>.
+
+You can override this default using the C<T2_FORMATTER> environment variable.
+
+Normally 'Test2::Formatter::' is prefixed to the value in the
+environment variable:
+
+ $ T2_FORMATTER='TAP' perl test.t # Use the Test2::Formatter::TAP formatter
+ $ T2_FORMATTER='Foo' perl test.t # Use the Test2::Formatter::Foo formatter
+
+If you want to specify a full module name you use the '+' prefix:
+
+ $ T2_FORMATTER='+Foo::Bar' perl test.t # Use the Foo::Bar formatter
+
+=item test2_formatter_set($class_or_instance)
+
+Set the global formatter class. This can only be set once. B<Note:> This will
+override anything specified in the 'T2_FORMATTER' environment variable.
+
+=item @formatters = test2_formatters()
+
+Get a list of all loaded formatters.
+
+=item test2_formatter_add($class_or_instance)
+
+Add a formatter to the list. Last formatter added is used at initialization. If
+this is called after initialization a warning will be issued.
+
+=back
+
+=head1 OTHER EXAMPLES
+
+See the C</Examples/> directory included in this distribution.
+
+=head1 SEE ALSO
+
+L<Test2::API::Context> - Detailed documentation of the context object.
+
+L<Test2::IPC> - The IPC system used for threading/fork support.
+
+L<Test2::Formatter> - Formatters such as TAP live here.
+
+L<Test2::Event> - Events live in this namespace.
+
+L<Test2::Hub> - All events eventually funnel through a hub. Custom hubs are how
+C<intercept()> and C<run_subtest()> are implemented.
+
+=head1 MAGIC
+
+This package has an END block. This END block is responsible for setting the
+exit code based on the test results. This end block also calls the callbacks that
+can be added to this package.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/API/Breakage.pm b/Master/tlpkg/tlperl/lib/Test2/API/Breakage.pm
new file mode 100755
index 00000000000..b85e4d54c9f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/API/Breakage.pm
@@ -0,0 +1,175 @@
+package Test2::API::Breakage;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Test2::Util qw/pkg_to_file/;
+
+our @EXPORT_OK = qw{
+ upgrade_suggested
+ upgrade_required
+ known_broken
+};
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
+
+sub upgrade_suggested {
+ return (
+ 'Test::Exception' => '0.42',
+ 'Test::FITesque' => '0.04',
+ 'Test::Module::Used' => '0.2.5',
+ 'Test::Moose::More' => '0.025',
+ );
+}
+
+sub upgrade_required {
+ return (
+ 'Test::Builder::Clutch' => '0.07',
+ 'Test::Dist::VersionSync' => '1.1.4',
+ 'Test::Modern' => '0.012',
+ 'Test::SharedFork' => '0.34',
+ 'Test::Alien' => '0.04',
+ 'Test::UseAllModules' => '0.14',
+
+ 'Test::Clustericious::Cluster' => '0.30',
+ );
+}
+
+sub known_broken {
+ return (
+ 'Net::BitTorrent' => '0.052',
+ 'Test::Able' => '0.11',
+ 'Test::Aggregate' => '0.373',
+ 'Test::Flatten' => '0.11',
+ 'Test::Group' => '0.20',
+ 'Test::More::Prefix' => '0.005',
+ 'Test::ParallelSubtest' => '0.05',
+ 'Test::Pretty' => '0.32',
+ 'Test::Wrapper' => '0.3.0',
+
+ 'Test::DBIx::Class::Schema' => '1.0.9',
+ 'Log::Dispatch::Config::TestLog' => '0.02',
+ );
+}
+
+# Not reportable:
+# Device::Chip => 0.07 - Tests will not pass, but not broken if already installed, also no fixed version we can upgrade to.
+
+sub report {
+ my $class = shift;
+ my ($require) = @_;
+
+ my %suggest = __PACKAGE__->upgrade_suggested();
+ my %required = __PACKAGE__->upgrade_required();
+ my %broken = __PACKAGE__->known_broken();
+
+ my @warn;
+ for my $mod (keys %suggest) {
+ my $file = pkg_to_file($mod);
+ 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.";
+ }
+
+ for my $mod (keys %required) {
+ my $file = pkg_to_file($mod);
+ next unless $INC{$file} || ($require && eval { require $file; 1 });
+ my $want = $required{$mod};
+ next if eval { $mod->VERSION($want); 1 };
+ push @warn => " * Module '$mod' is outdated and known to be broken, please update to $want or higher.";
+ }
+
+ for my $mod (keys %broken) {
+ my $file = pkg_to_file($mod);
+ next unless $INC{$file} || ($require && eval { require $file; 1 });
+ my $tested = $broken{$mod};
+ push @warn => " * Module '$mod' is known to be broken in version $tested and below, newer versions have not been tested. You have: " . $mod->VERSION;
+ }
+
+ return @warn;
+}
+
+1;
+
+__END__
+
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::Breakage - What breaks at what version
+
+=head1 DESCRIPTION
+
+This module provides lists of modules that are broken, or have been broken in
+the past, when upgrading L<Test::Builder> to use L<Test2>.
+
+=head1 FUNCTIONS
+
+These can be imported, or called as methods on the class.
+
+=over 4
+
+=item %mod_ver = upgrade_suggested()
+
+=item %mod_ver = Test2::API::Breakage->upgrade_suggested()
+
+This returns key/value pairs. The key is the module name, the value is the
+version number. If the installed version of the module is at or below the
+specified one then an upgrade would be a good idea, but not strictly necessary.
+
+=item %mod_ver = upgrade_required()
+
+=item %mod_ver = Test2::API::Breakage->upgrade_required()
+
+This returns key/value pairs. The key is the module name, the value is the
+version number. If the installed version of the module is at or below the
+specified one then an upgrade is required for the module to work properly.
+
+=item %mod_ver = known_broken()
+
+=item %mod_ver = Test2::API::Breakage->known_broken()
+
+This returns key/value pairs. The key is the module name, the value is the
+version number. If the installed version of the module is at or below the
+specified one then the module will not work. A newer version may work, but is
+not tested or verified.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/API/Context.pm b/Master/tlpkg/tlperl/lib/Test2/API/Context.pm
new file mode 100755
index 00000000000..7660fa69ea2
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/API/Context.pm
@@ -0,0 +1,739 @@
+package Test2::API::Context;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Carp qw/confess croak longmess/;
+use Scalar::Util qw/weaken blessed/;
+use Test2::Util qw/get_tid try pkg_to_file get_tid/;
+
+use Test2::Util::Trace();
+use Test2::API();
+
+# Preload some key event types
+my %LOADED = (
+ map {
+ my $pkg = "Test2::Event::$_";
+ my $file = "Test2/Event/$_.pm";
+ require $file unless $INC{$file};
+ ( $pkg => $pkg, $_ => $pkg )
+ } qw/Ok Diag Note Info Plan Bail Exception Waiting Skip Subtest/
+);
+
+use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
+use Test2::Util::HashBase qw{
+ stack hub trace _on_release _depth _is_canon _is_spawn _aborted
+ errno eval_error child_error thrown
+};
+
+# Private, not package vars
+# It is safe to cache these.
+my $ON_RELEASE = Test2::API::_context_release_callbacks_ref();
+my $CONTEXTS = Test2::API::_contexts_ref();
+
+sub init {
+ my $self = shift;
+
+ confess "The 'trace' attribute is required"
+ unless $self->{+TRACE};
+
+ confess "The 'hub' attribute is required"
+ unless $self->{+HUB};
+
+ $self->{+_DEPTH} = 0 unless defined $self->{+_DEPTH};
+
+ $self->{+ERRNO} = $! unless exists $self->{+ERRNO};
+ $self->{+EVAL_ERROR} = $@ unless exists $self->{+EVAL_ERROR};
+ $self->{+CHILD_ERROR} = $? unless exists $self->{+CHILD_ERROR};
+}
+
+sub snapshot { bless {%{$_[0]}, _is_canon => undef, _is_spawn => undef, _aborted => undef}, __PACKAGE__ }
+
+sub restore_error_vars {
+ my $self = shift;
+ ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};
+}
+
+sub DESTROY {
+ return unless $_[0]->{+_IS_CANON} || $_[0]->{+_IS_SPAWN};
+ return if $_[0]->{+_ABORTED} && ${$_[0]->{+_ABORTED}};
+ my ($self) = @_;
+
+ my $hub = $self->{+HUB};
+ my $hid = $hub->{hid};
+
+ # Do not show the warning if it looks like an exception has been thrown, or
+ # if the context is not local to this process or thread.
+ {
+ # Sometimes $@ is uninitialized, not a problem in this case so do not
+ # show the warning about using eq.
+ no warnings 'uninitialized';
+ if($self->{+EVAL_ERROR} eq $@ && $hub->is_local) {
+ my $frame = $self->{+_IS_SPAWN} || $self->{+TRACE}->frame;
+ warn <<" EOT";
+A context appears to have been destroyed without first calling release().
+Based on \$@ it does not look like an exception was thrown (this is not always
+a reliable test)
+
+This is a problem because the global error variables (\$!, \$@, and \$?) will
+not be restored. In addition some release callbacks will not work properly from
+inside a DESTROY method.
+
+Here are the context creation details, just in case a tool forgot to call
+release():
+ File: $frame->[1]
+ Line: $frame->[2]
+ Tool: $frame->[3]
+
+Cleaning up the CONTEXT stack...
+ EOT
+ }
+ }
+
+ return if $self->{+_IS_SPAWN};
+
+ # Remove the key itself to avoid a slow memory leak
+ delete $CONTEXTS->{$hid};
+ $self->{+_IS_CANON} = undef;
+
+ if (my $cbk = $self->{+_ON_RELEASE}) {
+ $_->($self) for reverse @$cbk;
+ }
+ if (my $hcbk = $hub->{_context_release}) {
+ $_->($self) for reverse @$hcbk;
+ }
+ $_->($self) for reverse @$ON_RELEASE;
+}
+
+# release exists to implement behaviors like die-on-fail. In die-on-fail you
+# want to die after a failure, but only after diagnostics have been reported.
+# The ideal time for the die to happen is when the context is released.
+# Unfortunately die does not work in a DESTROY block.
+sub release {
+ my ($self) = @_;
+
+ ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return if $self->{+THROWN};
+
+ ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return $self->{+_IS_SPAWN} = undef
+ if $self->{+_IS_SPAWN};
+
+ croak "release() should not be called on context that is neither canon nor a child"
+ unless $self->{+_IS_CANON};
+
+ my $hub = $self->{+HUB};
+ my $hid = $hub->{hid};
+
+ croak "context thinks it is canon, but it is not"
+ unless $CONTEXTS->{$hid} && $CONTEXTS->{$hid} == $self;
+
+ # Remove the key itself to avoid a slow memory leak
+ $self->{+_IS_CANON} = undef;
+ delete $CONTEXTS->{$hid};
+
+ if (my $cbk = $self->{+_ON_RELEASE}) {
+ $_->($self) for reverse @$cbk;
+ }
+ if (my $hcbk = $hub->{_context_release}) {
+ $_->($self) for reverse @$hcbk;
+ }
+ $_->($self) for reverse @$ON_RELEASE;
+
+ # Do this last so that nothing else changes them.
+ # If one of the hooks dies then these do not get restored, this is
+ # intentional
+ ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};
+
+ return;
+}
+
+sub do_in_context {
+ my $self = shift;
+ my ($sub, @args) = @_;
+
+ # We need to update the pid/tid and error vars.
+ my $clone = $self->snapshot;
+ @$clone{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} = ($!, $@, $?);
+ $clone->{+TRACE} = $clone->{+TRACE}->snapshot;
+ $clone->{+TRACE}->set_pid($$);
+ $clone->{+TRACE}->set_tid(get_tid());
+
+ my $hub = $clone->{+HUB};
+ my $hid = $hub->hid;
+
+ my $old = $CONTEXTS->{$hid};
+
+ $clone->{+_IS_CANON} = 1;
+ $CONTEXTS->{$hid} = $clone;
+ weaken($CONTEXTS->{$hid});
+ my ($ok, $err) = &try($sub, @args);
+ my ($rok, $rerr) = try { $clone->release };
+ delete $clone->{+_IS_CANON};
+
+ if ($old) {
+ $CONTEXTS->{$hid} = $old;
+ weaken($CONTEXTS->{$hid});
+ }
+ else {
+ delete $CONTEXTS->{$hid};
+ }
+
+ die $err unless $ok;
+ die $rerr unless $rok;
+}
+
+sub done_testing {
+ my $self = shift;
+ $self->hub->finalize($self->trace, 1);
+ return;
+}
+
+sub throw {
+ my ($self, $msg) = @_;
+ $self->{+THROWN} = 1;
+ ${$self->{+_ABORTED}}++ if $self->{+_ABORTED};
+ $self->release if $self->{+_IS_CANON} || $self->{+_IS_SPAWN};
+ $self->trace->throw($msg);
+}
+
+sub alert {
+ my ($self, $msg) = @_;
+ $self->trace->alert($msg);
+}
+
+sub send_event {
+ my $self = shift;
+ my $event = shift;
+ my %args = @_;
+
+ my $pkg = $LOADED{$event} || $self->_parse_event($event);
+
+ my $e = $pkg->new(
+ trace => $self->{+TRACE}->snapshot,
+ %args,
+ );
+
+ ${$self->{+_ABORTED}}++ if $self->{+_ABORTED} && defined $e->terminate;
+ $self->{+HUB}->send($e);
+}
+
+sub build_event {
+ my $self = shift;
+ my $event = shift;
+ my %args = @_;
+
+ my $pkg = $LOADED{$event} || $self->_parse_event($event);
+
+ $pkg->new(
+ trace => $self->{+TRACE}->snapshot,
+ %args,
+ );
+}
+
+sub ok {
+ my $self = shift;
+ my ($pass, $name, $on_fail) = @_;
+
+ my $hub = $self->{+HUB};
+
+ my $e = bless {
+ trace => bless( {%{$self->{+TRACE}}}, 'Test2::Util::Trace'),
+ pass => $pass,
+ name => $name,
+ }, 'Test2::Event::Ok';
+ $e->init;
+
+ $hub->send($e);
+ return $e if $pass;
+
+ $self->failure_diag($e);
+
+ if ($on_fail && @$on_fail) {
+ for my $of (@$on_fail) {
+ if (ref($of) eq 'CODE' || (blessed($of) && $of->can('render'))) {
+ $self->info($of, diagnostics => 1);
+ }
+ else {
+ $self->diag($of);
+ }
+ }
+ }
+
+ return $e;
+}
+
+sub failure_diag {
+ my $self = shift;
+ my ($e) = @_;
+
+ # This behavior is inherited from Test::Builder which injected a newline at
+ # the start of the first diagnostics when the harness is active, but not
+ # verbose. This is important to keep the diagnostics from showing up
+ # appended to the existing line, which is hard to read. In a verbose
+ # harness there is no need for this.
+ my $prefix = $ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_IS_VERBOSE} ? "\n" : "";
+
+ # Figure out the debug info, this is typically the file name and line
+ # number, but can also be a custom message. If no trace object is provided
+ # then we have nothing useful to display.
+ my $name = $e->name;
+ my $trace = $e->trace;
+ my $debug = $trace ? $trace->debug : "[No trace info available]";
+
+ # Create the initial diagnostics. If the test has a name we put the debug
+ # info on a second line, this behavior is inherited from Test::Builder.
+ my $msg = defined($name)
+ ? qq[${prefix}Failed test '$name'\n$debug.\n]
+ : qq[${prefix}Failed test $debug.\n];
+
+ $self->diag($msg);
+}
+
+sub skip {
+ my $self = shift;
+ my ($name, $reason, @extra) = @_;
+ $self->send_event(
+ 'Skip',
+ name => $name,
+ reason => $reason,
+ pass => 1,
+ @extra,
+ );
+}
+
+sub info {
+ my $self = shift;
+ my ($renderer, %params) = @_;
+ $self->send_event('Info', renderer => $renderer, %params);
+}
+
+sub note {
+ my $self = shift;
+ my ($message) = @_;
+ $self->send_event('Note', message => $message);
+}
+
+sub diag {
+ my $self = shift;
+ my ($message) = @_;
+ my $hub = $self->{+HUB};
+ $self->send_event(
+ 'Diag',
+ message => $message,
+ );
+}
+
+sub plan {
+ my ($self, $max, $directive, $reason) = @_;
+ $self->send_event('Plan', max => $max, directive => $directive, reason => $reason);
+}
+
+sub bail {
+ my ($self, $reason) = @_;
+ $self->send_event('Bail', reason => $reason);
+}
+
+sub _parse_event {
+ my $self = shift;
+ my $event = shift;
+
+ my $pkg;
+ if ($event =~ m/^\+(.*)/) {
+ $pkg = $1;
+ }
+ else {
+ $pkg = "Test2::Event::$event";
+ }
+
+ unless ($LOADED{$pkg}) {
+ my $file = pkg_to_file($pkg);
+ my ($ok, $err) = try { require $file };
+ $self->throw("Could not load event module '$pkg': $err")
+ unless $ok;
+
+ $LOADED{$pkg} = $pkg;
+ }
+
+ confess "'$pkg' is not a subclass of 'Test2::Event'"
+ unless $pkg->isa('Test2::Event');
+
+ $LOADED{$event} = $pkg;
+
+ return $pkg;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::Context - Object to represent a testing context.
+
+=head1 DESCRIPTION
+
+The context object is the primary interface for authors of testing tools
+written with L<Test2>. The context object represents the context in
+which a test takes place (File and Line Number), and provides a quick way to
+generate events from that context. The context object also takes care of
+sending events to the correct L<Test2::Hub> instance.
+
+=head1 SYNOPSIS
+
+In general you will not be creating contexts directly. To obtain a context you
+should always use C<context()> which is exported by the L<Test2::API> module.
+
+ use Test2::API qw/context/;
+
+ sub my_ok {
+ my ($bool, $name) = @_;
+ my $ctx = context();
+ $ctx->ok($bool, $name);
+ $ctx->release; # You MUST do this!
+ return $bool;
+ }
+
+Context objects make it easy to wrap other tools that also use context. Once
+you grab a context, any tool you call before releasing your context will
+inherit it:
+
+ sub wrapper {
+ my ($bool, $name) = @_;
+ my $ctx = context();
+ $ctx->diag("wrapping my_ok");
+
+ my $out = my_ok($bool, $name);
+ $ctx->release; # You MUST do this!
+ return $out;
+ }
+
+=head1 CRITICAL DETAILS
+
+=over 4
+
+=item you MUST always use the context() sub from Test2::API
+
+Creating your own context via C<< Test2::API::Context->new() >> will almost never
+produce a desirable result. Use C<context()> which is exported by L<Test2::API>.
+
+There are a handful of cases where a tool author may want to create a new
+context by hand, which is why the C<new> method exists. Unless you really know
+what you are doing you should avoid this.
+
+=item You MUST always release the context when done with it
+
+Releasing the context tells the system you are done with it. This gives it a
+chance to run any necessary callbacks or cleanup tasks. If you forget to
+release the context it will try to detect the problem and warn you about it.
+
+=item You MUST NOT pass context objects around
+
+When you obtain a context object it is made specifically for your tool and any
+tools nested within. If you pass a context around you run the risk of polluting
+other tools with incorrect context information.
+
+If you are certain that you want a different tool to use the same context you
+may pass it a snapshot. C<< $ctx->snapshot >> will give you a shallow clone of
+the context that is safe to pass around or store.
+
+=item You MUST NOT store or cache a context for later
+
+As long as a context exists for a given hub, all tools that try to get a
+context will get the existing instance. If you try to store the context you
+will pollute other tools with incorrect context information.
+
+If you are certain that you want to save the context for later, you can use a
+snapshot. C<< $ctx->snapshot >> will give you a shallow clone of the context
+that is safe to pass around or store.
+
+C<context()> has some mechanisms to protect you if you do cause a context to
+persist beyond the scope in which it was obtained. In practice you should not
+rely on these protections, and they are fairly noisy with warnings.
+
+=item You SHOULD obtain your context as soon as possible in a given tool
+
+You never know what tools you call from within your own tool will need a
+context. Obtaining the context early ensures that nested tools can find the
+context you want them to find.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $ctx->done_testing;
+
+Note that testing is finished. If no plan has been set this will generate a
+Plan event.
+
+=item $clone = $ctx->snapshot()
+
+This will return a shallow clone of the context. The shallow clone is safe to
+store for later.
+
+=item $ctx->release()
+
+This will release the context. This runs cleanup tasks, and several important
+hooks. It will also restore C<$!>, C<$?>, and C<$@> to what they were when the
+context was created.
+
+B<Note:> If a context is acquired more than once an internal refcount is kept.
+C<release()> decrements the ref count, none of the other actions of
+C<release()> will occur unless the refcount hits 0. This means only the last
+call to C<release()> will reset C<$?>, C<$!>, C<$@>,and run the cleanup tasks.
+
+=item $ctx->throw($message)
+
+This will throw an exception reporting to the file and line number of the
+context. This will also release the context for you.
+
+=item $ctx->alert($message)
+
+This will issue a warning from the file and line number of the context.
+
+=item $stack = $ctx->stack()
+
+This will return the L<Test2::API::Stack> instance the context used to find
+the current hub.
+
+=item $hub = $ctx->hub()
+
+This will return the L<Test2::Hub> instance the context recognizes as the
+current one to which all events should be sent.
+
+=item $dbg = $ctx->trace()
+
+This will return the L<Test2::Util::Trace> instance used by the context.
+
+=item $ctx->do_in_context(\&code, @args);
+
+Sometimes you have a context that is not current, and you want things to use it
+as the current one. In these cases you can call
+C<< $ctx->do_in_context(sub { ... }) >>. The codeblock will be run, and
+anything inside of it that looks for a context will find the one on which the
+method was called.
+
+This B<DOES NOT> affect context on other hubs, only the hub used by the context
+will be affected.
+
+ my $ctx = ...;
+ $ctx->do_in_context(sub {
+ my $ctx = context(); # returns the $ctx the sub is called on
+ });
+
+B<Note:> The context will actually be cloned, the clone will be used instead of
+the original. This allows the thread id, process id, and error variables to be correct without
+modifying the original context.
+
+=item $ctx->restore_error_vars()
+
+This will set C<$!>, C<$?>, and C<$@> to what they were when the context was
+created. There is no localization or anything done here, calling this method
+will actually set these vars.
+
+=item $! = $ctx->errno()
+
+The (numeric) value of C<$!> when the context was created.
+
+=item $? = $ctx->child_error()
+
+The value of C<$?> when the context was created.
+
+=item $@ = $ctx->eval_error()
+
+The value of C<$@> when the context was created.
+
+=back
+
+=head2 EVENT PRODUCTION METHODS
+
+=over 4
+
+=item $event = $ctx->ok($bool, $name)
+
+=item $event = $ctx->ok($bool, $name, \@on_fail)
+
+This will create an L<Test2::Event::Ok> object for you. If C<$bool> is false
+then an L<Test2::Event::Diag> event will be sent as well with details about the
+failure. If you do not want automatic diagnostics you should use the
+C<send_event()> method directly.
+
+The third argument C<\@on_fail>) is an optional set of diagnostics to be sent in
+the event of a test failure. Plain strings will be sent as
+L<Test2::Event::Diag> events. References will be used to construct
+L<Test2::Event::Info> events with C<< diagnostics => 1 >>.
+
+=item $event = $ctx->info($renderer, diagnostics => $bool, %other_params)
+
+Send an L<Test2::Event::Info>.
+
+=item $event = $ctx->note($message)
+
+Send an L<Test2::Event::Note>. This event prints a message to STDOUT.
+
+=item $event = $ctx->diag($message)
+
+Send an L<Test2::Event::Diag>. This event prints a message to STDERR.
+
+=item $event = $ctx->plan($max)
+
+=item $event = $ctx->plan(0, 'SKIP', $reason)
+
+This can be used to send an L<Test2::Event::Plan> event. This event
+usually takes either a number of tests you expect to run. Optionally you can
+set the expected count to 0 and give the 'SKIP' directive with a reason to
+cause all tests to be skipped.
+
+=item $event = $ctx->skip($name, $reason);
+
+Send an L<Test2::Event::Skip> event.
+
+=item $event = $ctx->bail($reason)
+
+This sends an L<Test2::Event::Bail> event. This event will completely
+terminate all testing.
+
+=item $event = $ctx->send_event($Type, %parameters)
+
+This lets you build and send an event of any type. The C<$Type> argument should
+be the event package name with C<Test2::Event::> left off, or a fully
+qualified package name prefixed with a '+'. The event is returned after it is
+sent.
+
+ my $event = $ctx->send_event('Ok', ...);
+
+or
+
+ my $event = $ctx->send_event('+Test2::Event::Ok', ...);
+
+=item $event = $ctx->build_event($Type, %parameters)
+
+This is the same as C<send_event()>, except it builds and returns the event
+without sending it.
+
+=back
+
+=head1 HOOKS
+
+There are 2 types of hooks, init hooks, and release hooks. As the names
+suggest, these hooks are triggered when contexts are created or released.
+
+=head2 INIT HOOKS
+
+These are called whenever a context is initialized. That means when a new
+instance is created. These hooks are B<NOT> called every time something
+requests a context, just when a new one is created.
+
+=head3 GLOBAL
+
+This is how you add a global init callback. Global callbacks happen for every
+context for any hub or stack.
+
+ Test2::API::test2_add_callback_context_init(sub {
+ my $ctx = shift;
+ ...
+ });
+
+=head3 PER HUB
+
+This is how you add an init callback for all contexts created for a given hub.
+These callbacks will not run for other hubs.
+
+ $hub->add_context_init(sub {
+ my $ctx = shift;
+ ...
+ });
+
+=head3 PER CONTEXT
+
+This is how you specify an init hook that will only run if your call to
+C<context()> generates a new context. The callback will be ignored if
+C<context()> is returning an existing context.
+
+ my $ctx = context(on_init => sub {
+ my $ctx = shift;
+ ...
+ });
+
+=head2 RELEASE HOOKS
+
+These are called whenever a context is released. That means when the last
+reference to the instance is about to be destroyed. These hooks are B<NOT>
+called every time C<< $ctx->release >> is called.
+
+=head3 GLOBAL
+
+This is how you add a global release callback. Global callbacks happen for every
+context for any hub or stack.
+
+ Test2::API::test2_add_callback_context_release(sub {
+ my $ctx = shift;
+ ...
+ });
+
+=head3 PER HUB
+
+This is how you add a release callback for all contexts created for a given
+hub. These callbacks will not run for other hubs.
+
+ $hub->add_context_release(sub {
+ my $ctx = shift;
+ ...
+ });
+
+=head3 PER CONTEXT
+
+This is how you add release callbacks directly to a context. The callback will
+B<ALWAYS> be added to the context that gets returned, it does not matter if a
+new one is generated, or if an existing one is returned.
+
+ my $ctx = context(on_release => sub {
+ my $ctx = shift;
+ ...
+ });
+
+=head1 THIRD PARTY META-DATA
+
+This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
+way for you to attach meta-data to instances of this class. This is useful for
+tools, plugins, and other extensions.
+
+=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>
+
+=item Kent Fredric E<lt>kentnl@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 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/Master/tlpkg/tlperl/lib/Test2/API/Instance.pm b/Master/tlpkg/tlperl/lib/Test2/API/Instance.pm
new file mode 100755
index 00000000000..70d4cd7bb78
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/API/Instance.pm
@@ -0,0 +1,754 @@
+package Test2::API::Instance;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
+use Carp qw/confess carp/;
+use Scalar::Util qw/reftype/;
+
+use Test2::Util qw/get_tid USE_THREADS CAN_FORK pkg_to_file try/;
+
+use Test2::Util::Trace();
+use Test2::API::Stack();
+
+use Test2::Util::HashBase qw{
+ _pid _tid
+ no_wait
+ finalized loaded
+ ipc stack formatter
+ contexts
+
+ ipc_shm_size
+ ipc_shm_last
+ ipc_shm_id
+ ipc_polling
+ ipc_drivers
+ formatters
+
+ exit_callbacks
+ post_load_callbacks
+ context_acquire_callbacks
+ context_init_callbacks
+ context_release_callbacks
+};
+
+sub pid { $_[0]->{+_PID} ||= $$ }
+sub tid { $_[0]->{+_TID} ||= get_tid() }
+
+# Wrap around the getters that should call _finalize.
+BEGIN {
+ for my $finalizer (IPC, FORMATTER) {
+ my $orig = __PACKAGE__->can($finalizer);
+ my $new = sub {
+ my $self = shift;
+ $self->_finalize unless $self->{+FINALIZED};
+ $self->$orig;
+ };
+
+ no strict 'refs';
+ no warnings 'redefine';
+ *{$finalizer} = $new;
+ }
+}
+
+sub import {
+ my $class = shift;
+ return unless @_;
+ my ($ref) = @_;
+ $$ref = $class->new;
+}
+
+sub init { $_[0]->reset }
+
+sub reset {
+ my $self = shift;
+
+ delete $self->{+_PID};
+ delete $self->{+_TID};
+
+ $self->{+CONTEXTS} = {};
+
+ $self->{+IPC_DRIVERS} = [];
+ $self->{+IPC_POLLING} = undef;
+
+ $self->{+FORMATTERS} = [];
+ $self->{+FORMATTER} = undef;
+
+ $self->{+FINALIZED} = undef;
+ $self->{+IPC} = undef;
+
+ $self->{+NO_WAIT} = 0;
+ $self->{+LOADED} = 0;
+
+ $self->{+EXIT_CALLBACKS} = [];
+ $self->{+POST_LOAD_CALLBACKS} = [];
+ $self->{+CONTEXT_ACQUIRE_CALLBACKS} = [];
+ $self->{+CONTEXT_INIT_CALLBACKS} = [];
+ $self->{+CONTEXT_RELEASE_CALLBACKS} = [];
+
+ $self->{+STACK} = Test2::API::Stack->new;
+}
+
+sub _finalize {
+ my $self = shift;
+ my ($caller) = @_;
+ $caller ||= [caller(1)];
+
+ $self->{+FINALIZED} = $caller;
+
+ $self->{+_PID} = $$ unless defined $self->{+_PID};
+ $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
+ unless ($self->{+FORMATTER}) {
+ my ($formatter, $source);
+ if ($ENV{T2_FORMATTER}) {
+ $source = "set by the 'T2_FORMATTER' environment variable";
+
+ if ($ENV{T2_FORMATTER} =~ m/^(\+)?(.*)$/) {
+ $formatter = $1 ? $2 : "Test2::Formatter::$2"
+ }
+ else {
+ $formatter = '';
+ }
+ }
+ elsif (@{$self->{+FORMATTERS}}) {
+ ($formatter) = @{$self->{+FORMATTERS}};
+ $source = "Most recently added";
+ }
+ else {
+ $formatter = 'Test2::Formatter::TAP';
+ $source = 'default formatter';
+ }
+
+ unless (ref($formatter) || $formatter->can('write')) {
+ my $file = pkg_to_file($formatter);
+ my ($ok, $err) = try { require $file };
+ unless ($ok) {
+ my $line = "* COULD NOT LOAD FORMATTER '$formatter' ($source) *";
+ my $border = '*' x length($line);
+ die "\n\n $border\n $line\n $border\n\n$err";
+ }
+ }
+
+ $self->{+FORMATTER} = $formatter;
+ }
+
+ # Turn on IPC if threads are on, drivers are registered, or the Test2::IPC
+ # module is loaded.
+ return unless USE_THREADS || $INC{'Test2/IPC.pm'} || @{$self->{+IPC_DRIVERS}};
+
+ # Turn on polling by default, people expect it.
+ $self->enable_ipc_polling;
+
+ unless (@{$self->{+IPC_DRIVERS}}) {
+ my ($ok, $error) = try { require Test2::IPC::Driver::Files };
+ die $error unless $ok;
+ push @{$self->{+IPC_DRIVERS}} => 'Test2::IPC::Driver::Files';
+ }
+
+ for my $driver (@{$self->{+IPC_DRIVERS}}) {
+ next unless $driver->can('is_viable') && $driver->is_viable;
+ $self->{+IPC} = $driver->new or next;
+ $self->ipc_enable_shm if $self->{+IPC}->use_shm;
+ return;
+ }
+
+ die "IPC has been requested, but no viable drivers were found. Aborting...\n";
+}
+
+sub formatter_set { $_[0]->{+FORMATTER} ? 1 : 0 }
+
+sub add_formatter {
+ my $self = shift;
+ my ($formatter) = @_;
+ unshift @{$self->{+FORMATTERS}} => $formatter;
+
+ return unless $self->{+FINALIZED};
+
+ # Why is the @CARP_NOT entry not enough?
+ local %Carp::Internal = %Carp::Internal;
+ $Carp::Internal{'Test2::Formatter'} = 1;
+
+ carp "Formatter $formatter loaded too late to be used as the global formatter";
+}
+
+sub add_context_acquire_callback {
+ my $self = shift;
+ my ($code) = @_;
+
+ my $rtype = reftype($code) || "";
+
+ confess "Context-acquire callbacks must be coderefs"
+ unless $code && $rtype eq 'CODE';
+
+ push @{$self->{+CONTEXT_ACQUIRE_CALLBACKS}} => $code;
+}
+
+sub add_context_init_callback {
+ my $self = shift;
+ my ($code) = @_;
+
+ my $rtype = reftype($code) || "";
+
+ confess "Context-init callbacks must be coderefs"
+ unless $code && $rtype eq 'CODE';
+
+ push @{$self->{+CONTEXT_INIT_CALLBACKS}} => $code;
+}
+
+sub add_context_release_callback {
+ my $self = shift;
+ my ($code) = @_;
+
+ my $rtype = reftype($code) || "";
+
+ confess "Context-release callbacks must be coderefs"
+ unless $code && $rtype eq 'CODE';
+
+ push @{$self->{+CONTEXT_RELEASE_CALLBACKS}} => $code;
+}
+
+sub add_post_load_callback {
+ my $self = shift;
+ my ($code) = @_;
+
+ my $rtype = reftype($code) || "";
+
+ confess "Post-load callbacks must be coderefs"
+ unless $code && $rtype eq 'CODE';
+
+ push @{$self->{+POST_LOAD_CALLBACKS}} => $code;
+ $code->() if $self->{+LOADED};
+}
+
+sub load {
+ my $self = shift;
+ unless ($self->{+LOADED}) {
+ $self->{+_PID} = $$ unless defined $self->{+_PID};
+ $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
+ # This is for https://github.com/Test-More/test-more/issues/16
+ # and https://rt.perl.org/Public/Bug/Display.html?id=127774
+ # END blocks run in reverse order. This insures the END block is loaded
+ # as late as possible. It will not solve all cases, but it helps.
+ eval "END { Test2::API::test2_set_is_end() }; 1" or die $@;
+
+ $self->{+LOADED} = 1;
+ $_->() for @{$self->{+POST_LOAD_CALLBACKS}};
+ }
+ return $self->{+LOADED};
+}
+
+sub add_exit_callback {
+ my $self = shift;
+ my ($code) = @_;
+ my $rtype = reftype($code) || "";
+
+ confess "End callbacks must be coderefs"
+ unless $code && $rtype eq 'CODE';
+
+ push @{$self->{+EXIT_CALLBACKS}} => $code;
+}
+
+sub add_ipc_driver {
+ my $self = shift;
+ my ($driver) = @_;
+ unshift @{$self->{+IPC_DRIVERS}} => $driver;
+
+ return unless $self->{+FINALIZED};
+
+ # Why is the @CARP_NOT entry not enough?
+ local %Carp::Internal = %Carp::Internal;
+ $Carp::Internal{'Test2::IPC::Driver'} = 1;
+
+ carp "IPC driver $driver loaded too late to be used as the global ipc driver";
+}
+
+sub enable_ipc_polling {
+ my $self = shift;
+
+ $self->{+_PID} = $$ unless defined $self->{+_PID};
+ $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
+ $self->add_context_init_callback(
+ # This is called every time a context is created, it needs to be fast.
+ # $_[0] is a context object
+ sub {
+ return unless $self->{+IPC_POLLING};
+ return $_[0]->{hub}->cull unless $self->{+IPC_SHM_ID};
+
+ my $val;
+ {
+ shmread($self->{+IPC_SHM_ID}, $val, 0, $self->{+IPC_SHM_SIZE}) or return;
+
+ return if $val eq $self->{+IPC_SHM_LAST};
+ $self->{+IPC_SHM_LAST} = $val;
+ }
+
+ $_[0]->{hub}->cull;
+ }
+ ) unless defined $self->ipc_polling;
+
+ $self->set_ipc_polling(1);
+}
+
+sub ipc_enable_shm {
+ my $self = shift;
+
+ return 1 if defined $self->{+IPC_SHM_ID};
+
+ $self->{+_PID} = $$ unless defined $self->{+_PID};
+ $self->{+_TID} = get_tid() unless defined $self->{+_TID};
+
+ my ($ok, $err) = try {
+ # SysV IPC can be available but not enabled.
+ #
+ # In some systems (*BSD) accessing the SysV IPC APIs without
+ # them being enabled can cause a SIGSYS. We suppress the SIGSYS
+ # and then get ENOSYS from the calls.
+ local $SIG{SYS} = 'IGNORE';
+
+ require IPC::SysV;
+
+ my $ipc_key = IPC::SysV::IPC_PRIVATE();
+ my $shm_size = $self->{+IPC}->can('shm_size') ? $self->{+IPC}->shm_size : 64;
+ my $shm_id = shmget($ipc_key, $shm_size, 0666) or die;
+
+ my $initial = 'a' x $shm_size;
+ shmwrite($shm_id, $initial, 0, $shm_size) or die;
+
+ $self->{+IPC_SHM_SIZE} = $shm_size;
+ $self->{+IPC_SHM_ID} = $shm_id;
+ $self->{+IPC_SHM_LAST} = $initial;
+ };
+
+ return $ok;
+}
+
+sub ipc_free_shm {
+ my $self = shift;
+
+ my $id = delete $self->{+IPC_SHM_ID};
+ return unless defined $id;
+
+ shmctl($id, IPC::SysV::IPC_RMID(), 0);
+}
+
+sub get_ipc_pending {
+ my $self = shift;
+ return -1 unless defined $self->{+IPC_SHM_ID};
+ my $val;
+ shmread($self->{+IPC_SHM_ID}, $val, 0, $self->{+IPC_SHM_SIZE}) or return -1;
+ return 0 if $val eq $self->{+IPC_SHM_LAST};
+ $self->{+IPC_SHM_LAST} = $val;
+ return 1;
+}
+
+sub set_ipc_pending {
+ my $self = shift;
+
+ return undef unless defined $self->{+IPC_SHM_ID};
+
+ my ($val) = @_;
+
+ confess "value is required for set_ipc_pending"
+ unless $val;
+
+ shmwrite($self->{+IPC_SHM_ID}, $val, 0, $self->{+IPC_SHM_SIZE});
+}
+
+sub disable_ipc_polling {
+ my $self = shift;
+ return unless defined $self->{+IPC_POLLING};
+ $self->{+IPC_POLLING} = 0;
+}
+
+sub _ipc_wait {
+ my $fail = 0;
+
+ if (CAN_FORK) {
+ while (1) {
+ my $pid = CORE::wait();
+ my $err = $?;
+ last if $pid == -1;
+ next unless $err;
+ $fail++;
+ $err = $err >> 8;
+ warn "Process $pid did not exit cleanly (status: $err)\n";
+ }
+ }
+
+ if (USE_THREADS) {
+ for my $t (threads->list()) {
+ $t->join;
+ # In older threads we cannot check if a thread had an error unless
+ # we control it and its return.
+ my $err = $t->can('error') ? $t->error : undef;
+ next unless $err;
+ my $tid = $t->tid();
+ $fail++;
+ chomp($err);
+ warn "Thread $tid did not end cleanly: $err\n";
+ }
+ }
+
+ return 0 unless $fail;
+ return 255;
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ return unless defined($self->{+_PID}) && $self->{+_PID} == $$;
+ return unless defined($self->{+_TID}) && $self->{+_TID} == get_tid();
+
+ shmctl($self->{+IPC_SHM_ID}, IPC::SysV::IPC_RMID(), 0)
+ if defined $self->{+IPC_SHM_ID};
+}
+
+sub set_exit {
+ my $self = shift;
+
+ my $exit = $?;
+ my $new_exit = $exit;
+
+ if ($INC{'Test/Builder.pm'} && $Test::Builder::VERSION ne $Test2::API::VERSION) {
+ print STDERR <<" EOT";
+
+********************************************************************************
+* *
+* Test::Builder -- Test2::API version mismatch detected *
+* *
+********************************************************************************
+ Test2::API Version: $Test2::API::VERSION
+Test::Builder Version: $Test::Builder::VERSION
+
+This is not a supported configuration, you will have problems.
+
+ EOT
+ }
+
+ for my $ctx (values %{$self->{+CONTEXTS}}) {
+ next unless $ctx;
+
+ next if $ctx->_aborted && ${$ctx->_aborted};
+
+ # Only worry about contexts in this PID
+ my $trace = $ctx->trace || next;
+ next unless $trace->pid && $trace->pid == $$;
+
+ # Do not worry about contexts that have no hub
+ my $hub = $ctx->hub || next;
+
+ # Do not worry if the state came to a sudden end.
+ next if $hub->bailed_out;
+ next if defined $hub->skip_reason;
+
+ # now we worry
+ $trace->alert("context object was never released! This means a testing tool is behaving very badly");
+
+ $exit = 255;
+ $new_exit = 255;
+ }
+
+ if (!defined($self->{+_PID}) or !defined($self->{+_TID}) or $self->{+_PID} != $$ or $self->{+_TID} != get_tid()) {
+ $? = $exit;
+ return;
+ }
+
+ my @hubs = $self->{+STACK} ? $self->{+STACK}->all : ();
+
+ if (@hubs and $self->{+IPC} and !$self->{+NO_WAIT}) {
+ local $?;
+ my %seen;
+ for my $hub (reverse @hubs) {
+ my $ipc = $hub->ipc or next;
+ next if $seen{$ipc}++;
+ $ipc->waiting();
+ }
+
+ my $ipc_exit = _ipc_wait();
+ $new_exit ||= $ipc_exit;
+ }
+
+ # None of this is necessary if we never got a root hub
+ if(my $root = shift @hubs) {
+ my $trace = Test2::Util::Trace->new(
+ frame => [__PACKAGE__, __FILE__, 0, __PACKAGE__ . '::END'],
+ detail => __PACKAGE__ . ' END Block finalization',
+ );
+ my $ctx = Test2::API::Context->new(
+ trace => $trace,
+ hub => $root,
+ );
+
+ if (@hubs) {
+ $ctx->diag("Test ended with extra hubs on the stack!");
+ $new_exit = 255;
+ }
+
+ unless ($root->no_ending) {
+ local $?;
+ $root->finalize($trace) unless $root->ended;
+ $_->($ctx, $exit, \$new_exit) for @{$self->{+EXIT_CALLBACKS}};
+ $new_exit ||= $root->failed;
+ $new_exit ||= 255 unless $root->is_passing;
+ }
+ }
+
+ $new_exit = 255 if $new_exit > 255;
+
+ if ($new_exit && eval { require Test2::API::Breakage; 1 }) {
+ my @warn = Test2::API::Breakage->report();
+
+ if (@warn) {
+ print STDERR "\nYou have loaded versions of test modules known to have problems with Test2.\nThis could explain some test failures.\n";
+ print STDERR "$_\n" for @warn;
+ print STDERR "\n";
+ }
+ }
+
+ $? = $new_exit;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::Instance - Object used by Test2::API under the hood
+
+=head1 DESCRIPTION
+
+This object encapsulates the global shared state tracked by
+L<Test2>. A single global instance of this package is stored (and
+obscured) by the L<Test2::API> package.
+
+There is no reason to directly use this package. This package is documented for
+completeness. This package can change, or go away completely at any time.
+Directly using, or monkeypatching this package is not supported in any way
+shape or form.
+
+=head1 SYNOPSIS
+
+ use Test2::API::Instance;
+
+ my $obj = Test2::API::Instance->new;
+
+=over 4
+
+=item $pid = $obj->pid
+
+PID of this instance.
+
+=item $obj->tid
+
+Thread ID of this instance.
+
+=item $obj->reset()
+
+Reset the object to defaults.
+
+=item $obj->load()
+
+Set the internal state to loaded, and run and stored post-load callbacks.
+
+=item $bool = $obj->loaded
+
+Check if the state is set to loaded.
+
+=item $arrayref = $obj->post_load_callbacks
+
+Get the post-load callbacks.
+
+=item $obj->add_post_load_callback(sub { ... })
+
+Add a post-load callback. If C<load()> has already been called then the callback will
+be immediately executed. If C<load()> has not been called then the callback will be
+stored and executed later when C<load()> is called.
+
+=item $hashref = $obj->contexts()
+
+Get a hashref of all active contexts keyed by hub id.
+
+=item $arrayref = $obj->context_acquire_callbacks
+
+Get all context acquire callbacks.
+
+=item $arrayref = $obj->context_init_callbacks
+
+Get all context init callbacks.
+
+=item $arrayref = $obj->context_release_callbacks
+
+Get all context release callbacks.
+
+=item $obj->add_context_init_callback(sub { ... })
+
+Add a context init callback. Subs are called every time a context is created. Subs
+get the newly created context as their only argument.
+
+=item $obj->add_context_release_callback(sub { ... })
+
+Add a context release callback. Subs are called every time a context is released. Subs
+get the released context as their only argument. These callbacks should not
+call release on the context.
+
+=item $obj->set_exit()
+
+This is intended to be called in an C<END { ... }> block. This will look at
+test state and set $?. This will also call any end callbacks, and wait on child
+processes/threads.
+
+=item $obj->ipc_enable_shm()
+
+Turn on SHM for IPC (if possible)
+
+=item $shm_id = $obj->ipc_shm_id()
+
+If SHM is enabled for IPC this will be the shm_id for it.
+
+=item $shm_size = $obj->ipc_shm_size()
+
+If SHM is enabled for IPC this will be the size of it.
+
+=item $shm_last_val = $obj->ipc_shm_last()
+
+If SHM is enabled for IPC this will return the last SHM value seen.
+
+=item $obj->set_ipc_pending($val)
+
+use the IPC SHM to tell other processes and threads there is a pending event.
+C<$val> should be a unique value no other thread/process will generate.
+
+B<Note:> This will also make the current process see a pending event. It does
+not set C<ipc_shm_last()>, this is important because doing so could hide a
+previous change.
+
+=item $pending = $obj->get_ipc_pending()
+
+This returns -1 if SHM is not enabled for IPC.
+
+This returns 0 if the SHM value matches the last known value, which means there
+are no pending events.
+
+This returns 1 if the SHM value has changed, which means there are probably
+pending events.
+
+When 1 is returned this will set C<< $obj->ipc_shm_last() >>.
+
+=item $drivers = $obj->ipc_drivers
+
+Get the list of IPC drivers.
+
+=item $obj->add_ipc_driver($DRIVER_CLASS)
+
+Add an IPC driver to the list. The most recently added IPC driver will become
+the global one during initialization. If a driver is added after initialization
+has occurred a warning will be generated:
+
+ "IPC driver $driver loaded too late to be used as the global ipc driver"
+
+=item $bool = $obj->ipc_polling
+
+Check if polling is enabled.
+
+=item $obj->enable_ipc_polling
+
+Turn on polling. This will cull events from other processes and threads every
+time a context is created.
+
+=item $obj->disable_ipc_polling
+
+Turn off IPC polling.
+
+=item $bool = $obj->no_wait
+
+=item $bool = $obj->set_no_wait($bool)
+
+Get/Set no_wait. This option is used to turn off process/thread waiting at exit.
+
+=item $arrayref = $obj->exit_callbacks
+
+Get the exit callbacks.
+
+=item $obj->add_exit_callback(sub { ... })
+
+Add an exit callback. This callback will be called by C<set_exit()>.
+
+=item $bool = $obj->finalized
+
+Check if the object is finalized. Finalization happens when either C<ipc()>,
+C<stack()>, or C<format()> are called on the object. Once finalization happens
+these fields are considered unchangeable (not enforced here, enforced by
+L<Test2>).
+
+=item $ipc = $obj->ipc
+
+Get the one true IPC instance.
+
+=item $stack = $obj->stack
+
+Get the one true hub stack.
+
+=item $formatter = $obj->formatter
+
+Get the global formatter. By default this is the C<'Test2::Formatter::TAP'>
+package. This could be any package that implements the C<write()> method. This
+can also be an instantiated object.
+
+=item $bool = $obj->formatter_set()
+
+Check if a formatter has been set.
+
+=item $obj->add_formatter($class)
+
+=item $obj->add_formatter($obj)
+
+Add a formatter. The most recently added formatter will become the global one
+during initialization. If a formatter is added after initialization has occurred
+a warning will be generated:
+
+ "Formatter $formatter loaded too late to be used as the global formatter"
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm b/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm
new file mode 100755
index 00000000000..534cd78d1ba
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/API/Stack.pm
@@ -0,0 +1,220 @@
+package Test2::API::Stack;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Test2::Hub();
+
+use Carp qw/confess/;
+
+sub new {
+ my $class = shift;
+ return bless [], $class;
+}
+
+sub new_hub {
+ my $self = shift;
+ my %params = @_;
+
+ my $class = delete $params{class} || 'Test2::Hub';
+
+ my $hub = $class->new(%params);
+
+ if (@$self) {
+ $hub->inherit($self->[-1], %params);
+ }
+ else {
+ require Test2::API;
+ $hub->format(Test2::API::test2_formatter()->new)
+ unless $hub->format || exists($params{formatter});
+
+ my $ipc = Test2::API::test2_ipc();
+ if ($ipc && !$hub->ipc && !exists($params{ipc})) {
+ $hub->set_ipc($ipc);
+ $ipc->add_hub($hub->hid);
+ }
+ }
+
+ push @$self => $hub;
+
+ $hub;
+}
+
+sub top {
+ my $self = shift;
+ return $self->new_hub unless @$self;
+ return $self->[-1];
+}
+
+sub peek {
+ my $self = shift;
+ return @$self ? $self->[-1] : undef;
+}
+
+sub cull {
+ my $self = shift;
+ $_->cull for reverse @$self;
+}
+
+sub all {
+ my $self = shift;
+ return @$self;
+}
+
+sub clear {
+ my $self = shift;
+ @$self = ();
+}
+
+# Do these last without keywords in order to prevent them from getting used
+# when we want the real push/pop.
+
+{
+ no warnings 'once';
+
+ *push = sub {
+ my $self = shift;
+ my ($hub) = @_;
+ $hub->inherit($self->[-1]) if @$self;
+ push @$self => $hub;
+ };
+
+ *pop = sub {
+ my $self = shift;
+ my ($hub) = @_;
+ confess "No hubs on the stack"
+ unless @$self;
+ confess "You cannot pop the root hub"
+ if 1 == @$self;
+ confess "Hub stack mismatch, attempted to pop incorrect hub"
+ unless $self->[-1] == $hub;
+ pop @$self;
+ };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::API::Stack - Object to manage a stack of L<Test2::Hub>
+instances.
+
+=head1 ***INTERNALS NOTE***
+
+B<The internals of this package are subject to change at any time!> The public
+methods provided will not change in backwards incompatible ways, but the
+underlying implementation details might. B<Do not break encapsulation here!>
+
+=head1 DESCRIPTION
+
+This module is used to represent and manage a stack of L<Test2::Hub>
+objects. Hubs are usually in a stack so that you can push a new hub into place
+that can intercept and handle events differently than the primary hub.
+
+=head1 SYNOPSIS
+
+ my $stack = Test2::API::Stack->new;
+ my $hub = $stack->top;
+
+=head1 METHODS
+
+=over 4
+
+=item $stack = Test2::API::Stack->new()
+
+This will create a new empty stack instance. All arguments are ignored.
+
+=item $hub = $stack->new_hub()
+
+=item $hub = $stack->new_hub(%params)
+
+=item $hub = $stack->new_hub(%params, class => $class)
+
+This will generate a new hub and push it to the top of the stack. Optionally
+you can provide arguments that will be passed into the constructor for the
+L<Test2::Hub> object.
+
+If you specify the C<< 'class' => $class >> argument, the new hub will be an
+instance of the specified class.
+
+Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the
+formatter and IPC instance will be inherited from the current top hub. You can
+set the parameters to C<undef> to avoid having a formatter or IPC instance.
+
+If there is no top hub, and you do not ask to leave IPC and formatter undef,
+then a new formatter will be created, and the IPC instance from
+L<Test2::API> will be used.
+
+=item $hub = $stack->top()
+
+This will return the top hub from the stack. If there is no top hub yet this
+will create it.
+
+=item $hub = $stack->peek()
+
+This will return the top hub from the stack. If there is no top hub yet this
+will return undef.
+
+=item $stack->cull
+
+This will call C<< $hub->cull >> on all hubs in the stack.
+
+=item @hubs = $stack->all
+
+This will return all the hubs in the stack as a list.
+
+=item $stack->clear
+
+This will completely remove all hubs from the stack. Normally you do not want
+to do this, but there are a few valid reasons for it.
+
+=item $stack->push($hub)
+
+This will push the new hub onto the stack.
+
+=item $stack->pop($hub)
+
+This will pop a hub from the stack, if the hub at the top of the stack does not
+match the hub you expect (passed in as an argument) it will throw an exception.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event.pm b/Master/tlpkg/tlperl/lib/Test2/Event.pm
new file mode 100755
index 00000000000..a59a366081d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event.pm
@@ -0,0 +1,254 @@
+package Test2::Event;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+use Test2::Util::HashBase qw/trace nested in_subtest subtest_id/;
+use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
+use Test2::Util qw(pkg_to_file);
+use Test2::Util::Trace;
+
+sub causes_fail { 0 }
+sub increments_count { 0 }
+sub diagnostics { 0 }
+sub no_display { 0 }
+
+sub callback { }
+
+sub terminate { () }
+sub global { () }
+sub sets_plan { () }
+
+sub summary { ref($_[0]) }
+
+sub from_json {
+ my $class = shift;
+ my %p = @_;
+
+ my $event_pkg = delete $p{__PACKAGE__};
+ require(pkg_to_file($event_pkg));
+
+ if (exists $p{trace}) {
+ $p{trace} = Test2::Util::Trace->from_json(%{$p{trace}});
+ }
+
+ if (exists $p{subevents}) {
+ my @subevents;
+ for my $subevent (@{delete $p{subevents} || []}) {
+ push @subevents, Test2::Event->from_json(%$subevent);
+ }
+ $p{subevents} = \@subevents;
+ }
+
+ return $event_pkg->new(%p);
+}
+
+sub TO_JSON {
+ my $self = shift;
+ return {%$self, __PACKAGE__ => ref $self};
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event - Base class for events
+
+=head1 DESCRIPTION
+
+Base class for all event objects that get passed through
+L<Test2>.
+
+=head1 SYNOPSIS
+
+ package Test2::Event::MyEvent;
+ use strict;
+ use warnings;
+
+ # This will make our class an event subclass (required)
+ use base 'Test2::Event';
+
+ # Add some accessors (optional)
+ # You are not obligated to use HashBase, you can use any object tool you
+ # want, or roll your own accessors.
+ use Test2::Util::HashBase qw/foo bar baz/;
+
+ # Chance to initialize some defaults
+ sub init {
+ my $self = shift;
+ # no other args in @_
+
+ $self->set_foo('xxx') unless defined $self->foo;
+
+ ...
+ }
+
+ 1;
+
+=head1 METHODS
+
+=over 4
+
+=item $trace = $e->trace
+
+Get a snapshot of the L<Test2::Util::Trace> as it was when this event was
+generated
+
+=item $bool = $e->causes_fail
+
+Returns true if this event should result in a test failure. In general this
+should be false.
+
+=item $bool = $e->increments_count
+
+Should be true if this event should result in a test count increment.
+
+=item $e->callback($hub)
+
+If your event needs to have extra effects on the L<Test2::Hub> you can override
+this method.
+
+This is called B<BEFORE> your event is passed to the formatter.
+
+=item $call = $e->created
+
+Get the C<caller()> details from when the event was generated. This is usually
+inside a tools package. This is typically used for debugging.
+
+=item $num = $e->nested
+
+If this event is nested inside of other events, this should be the depth of
+nesting. (This is mainly for subtests)
+
+=item $bool = $e->global
+
+Set this to true if your event is global, that is ALL threads and processes
+should see it no matter when or where it is generated. This is not a common
+thing to want, it is used by bail-out and skip_all to end testing.
+
+=item $code = $e->terminate
+
+This is called B<AFTER> your event has been passed to the formatter. This
+should normally return undef, only change this if your event should cause the
+test to exit immediately.
+
+If you want this event to cause the test to exit you should return the exit
+code here. Exit code of 0 means exit success, any other integer means exit with
+failure.
+
+This is used by L<Test2::Event::Plan> to exit 0 when the plan is
+'skip_all'. This is also used by L<Test2::Event:Bail> to force the test
+to exit with a failure.
+
+This is called after the event has been sent to the formatter in order to
+ensure the event is seen and understood.
+
+=item $todo = $e->todo
+
+=item $e->set_todo($todo)
+
+Get/Set the todo reason on the event. Any value other than C<undef> makes the
+event 'TODO'.
+
+Not all events make use of this field, but they can all have it set/cleared.
+
+=item $bool = $e->diag_todo
+
+=item $e->diag_todo($todo)
+
+True if this event should be considered 'TODO' for diagnostics purposes. This
+essentially means that any message that would go to STDERR will go to STDOUT
+instead so that a harness will hide it outside of verbose mode.
+
+=item $msg = $e->summary
+
+This is intended to be a human readable summary of the event. This should
+ideally only be one line long, but you can use multiple lines if necessary. This
+is intended for human consumption. You do not need to make it easy for machines
+to understand.
+
+The default is to simply return the event package name.
+
+=item ($count, $directive, $reason) = $e->sets_plan()
+
+Check if this event sets the testing plan. It will return an empty list if it
+does not. If it does set the plan it will return a list of 1 to 3 items in
+order: Expected Test Count, Test Directive, Reason for directive.
+
+=item $bool = $e->diagnostics
+
+True if the event contains diagnostics info. This is useful because a
+non-verbose harness may choose to hide events that are not in this category.
+Some formatters may choose to send these to STDERR instead of STDOUT to ensure
+they are seen.
+
+=item $bool = $e->no_display
+
+False by default. This will return true on events that should not be displayed
+by formatters.
+
+=item $id = $e->in_subtest
+
+If the event is inside a subtest this should have the subtest ID.
+
+=item $id = $e->subtest_id
+
+If the event is a final subtest event, this should contain the subtest ID.
+
+=item $hashref = $e->TO_JSON
+
+This returns a hashref suitable for passing to the C<< Test2::Event->from_json
+>> constructor. It is intended for use with the L<JSON> family of modules,
+which will look for a C<TO_JSON> method when C<convert_blessed> is true.
+
+=item $e = Test2::Event->from_json(%$hashref)
+
+Given the hash of data returned by C<< $e->TO_JSON >>, this method returns a
+new event object of the appropriate subclass.
+
+=back
+
+=head1 THIRD PARTY META-DATA
+
+This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
+way for you to attach meta-data to instances of this class. This is useful for
+tools, plugins, and other extensions.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Bail.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Bail.pm
new file mode 100755
index 00000000000..0284aecd00f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Bail.pm
@@ -0,0 +1,102 @@
+package Test2::Event::Bail;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw{reason};
+
+sub callback {
+ my $self = shift;
+ my ($hub) = @_;
+
+ $hub->set_bailed_out($self);
+}
+
+# Make sure the tests terminate
+sub terminate { 255 };
+
+sub global { 1 };
+
+sub causes_fail { 1 }
+
+sub summary {
+ my $self = shift;
+ return "Bail out! " . $self->{+REASON}
+ if $self->{+REASON};
+
+ return "Bail out!";
+}
+
+sub diagnostics { 1 }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Bail - Bailout!
+
+=head1 DESCRIPTION
+
+The bailout event is generated when things go horribly wrong and you need to
+halt all testing in the current file.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Bail;
+
+ my $ctx = context();
+ my $event = $ctx->bail('Stuff is broken');
+
+=head1 METHODS
+
+Inherits from L<Test2::Event>. Also defines:
+
+=over 4
+
+=item $reason = $e->reason
+
+The reason for the bailout.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Diag.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Diag.pm
new file mode 100755
index 00000000000..9d2ba88d6e3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Diag.pm
@@ -0,0 +1,83 @@
+package Test2::Event::Diag;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw/message/;
+
+sub init {
+ $_[0]->{+MESSAGE} = 'undef' unless defined $_[0]->{+MESSAGE};
+}
+
+sub summary { $_[0]->{+MESSAGE} }
+
+sub diagnostics { 1 }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Diag - Diag event type
+
+=head1 DESCRIPTION
+
+Diagnostics messages, typically rendered to STDERR.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Diag;
+
+ my $ctx = context();
+ my $event = $ctx->diag($message);
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $diag->message
+
+The message for the diag.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Encoding.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Encoding.pm
new file mode 100755
index 00000000000..52af3f2dc51
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Encoding.pm
@@ -0,0 +1,86 @@
+package Test2::Event::Encoding;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw/encoding/;
+
+sub init {
+ my $self = shift;
+ defined $self->{+ENCODING} or $self->trace->throw("'encoding' is a required attribute");
+}
+
+sub summary { 'Encoding set to ' . $_[0]->{+ENCODING} }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Encoding - Set the encoding for the output stream
+
+=head1 DESCRIPTION
+
+The encoding event is generated when a test file wants to specify the encoding
+to be used when formatting its output. This event is intended to be produced
+by formatter classes and used for interpreting test names, message contents,
+etc.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Encoding;
+
+ my $ctx = context();
+ my $event = $ctx->send_event('Encoding', encoding => 'UTF-8');
+
+=head1 METHODS
+
+Inherits from L<Test2::Event>. Also defines:
+
+=over 4
+
+=item $encoding = $e->encoding
+
+The encoding being specified.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Exception.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Exception.pm
new file mode 100755
index 00000000000..a10ca6756c0
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Exception.pm
@@ -0,0 +1,88 @@
+package Test2::Event::Exception;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw{error};
+
+sub causes_fail { 1 }
+
+sub summary {
+ my $self = shift;
+ chomp(my $msg = "Exception: " . $self->{+ERROR});
+ return $msg;
+}
+
+sub diagnostics { 1 }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Exception - Exception event
+
+=head1 DESCRIPTION
+
+An exception event will display to STDERR, and will prevent the overall test
+file from passing.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Exception;
+
+ my $ctx = context();
+ my $event = $ctx->send_event('Exception', error => 'Stuff is broken');
+
+=head1 METHODS
+
+Inherits from L<Test2::Event>. Also defines:
+
+=over 4
+
+=item $reason = $e->error
+
+The reason for the exception.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Generic.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Generic.pm
new file mode 100755
index 00000000000..ad00f5a963d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Generic.pm
@@ -0,0 +1,263 @@
+package Test2::Event::Generic;
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use Scalar::Util qw/reftype/;
+
+our $VERSION = '1.302073';
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase;
+
+my @FIELDS = qw{
+ causes_fail increments_count diagnostics no_display callback terminate
+ global sets_plan summary
+};
+my %DEFAULTS = (
+ causes_fail => 0,
+ increments_count => 0,
+ diagnostics => 0,
+ no_display => 0,
+);
+
+sub init {
+ my $self = shift;
+
+ for my $field (@FIELDS) {
+ my $val = defined $self->{$field} ? delete $self->{$field} : $DEFAULTS{$field};
+ next unless defined $val;
+
+ my $set = "set_$field";
+ $self->$set($val);
+ }
+}
+
+for my $field (@FIELDS) {
+ no strict 'refs';
+ my $stash = \%{__PACKAGE__ . "::"};
+
+ *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () }
+ unless defined $stash->{$field}
+ && defined *{$stash->{$field}}{CODE};
+
+ *{"set_$field"} = sub { $_[0]->{$field} = $_[1] }
+ unless defined $stash->{"set_$field"}
+ && defined *{$stash->{"set_$field"}}{CODE};
+}
+
+sub summary {
+ my $self = shift;
+ return $self->{summary} if defined $self->{summary};
+ $self->SUPER::summary();
+}
+
+sub sets_plan {
+ my $self = shift;
+ return unless $self->{sets_plan};
+ return @{$self->{sets_plan}};
+}
+
+sub callback {
+ my $self = shift;
+ my $cb = $self->{callback} || return;
+ $self->$cb(@_);
+}
+
+sub set_global {
+ my $self = shift;
+ my ($bool) = @_;
+
+ if(!defined $bool) {
+ delete $self->{global};
+ return undef;
+ }
+
+ $self->{global} = $bool;
+}
+
+sub set_callback {
+ my $self = shift;
+ my ($cb) = @_;
+
+ if(!defined $cb) {
+ delete $self->{callback};
+ return undef;
+ }
+
+ croak "callback must be a code reference"
+ unless ref($cb) && reftype($cb) eq 'CODE';
+
+ $self->{callback} = $cb;
+}
+
+sub set_terminate {
+ my $self = shift;
+ my ($exit) = @_;
+
+ if(!defined $exit) {
+ delete $self->{terminate};
+ return undef;
+ }
+
+ croak "terminate must be a positive integer"
+ unless $exit =~ m/^\d+$/;
+
+ $self->{terminate} = $exit;
+}
+
+sub set_sets_plan {
+ my $self = shift;
+ my ($plan) = @_;
+
+ if(!defined $plan) {
+ delete $self->{sets_plan};
+ return undef;
+ }
+
+ croak "'sets_plan' must be an array reference"
+ unless ref($plan) && reftype($plan) eq 'ARRAY';
+
+ $self->{sets_plan} = $plan;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Generic - Generic event type.
+
+=head1 DESCRIPTION
+
+This is a generic event that lets you customize all fields in the event API.
+This is useful if you have need for a custom event that does not make sense as
+a published reusable event subclass.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+
+ sub send_custom_fail {
+ my $ctx = shift;
+
+ $ctx->send_event('Generic', causes_fail => 1, summary => 'The sky is falling');
+
+ $ctx->release;
+ }
+
+ send_custom_fail();
+
+=head1 METHODS
+
+=over 4
+
+=item $e->callback($hub)
+
+Call the custom callback if one is set, otherwise this does nothing.
+
+=item $e->set_callback(sub { ... })
+
+Set the custom callback. The custom callback must be a coderef. The first
+argument to your callback will be the event itself, the second will be the
+L<Test2::Event::Hub> that is using the callback.
+
+=item $bool = $e->causes_fail
+
+=item $e->set_causes_fail($bool)
+
+Get/Set the C<causes_fail> attribute. This defaults to C<0>.
+
+=item $bool = $e->diagnostics
+
+=item $e->set_diagnostics($bool)
+
+Get/Set the C<diagnostics> attribute. This defaults to C<0>.
+
+=item $bool_or_undef = $e->global
+
+=item @bool_or_empty = $e->global
+
+=item $e->set_global($bool_or_undef)
+
+Get/Set the C<diagnostics> attribute. This defaults to an empty list which is
+undef in scalar context.
+
+=item $bool = $e->increments_count
+
+=item $e->set_increments_count($bool)
+
+Get/Set the C<increments_count> attribute. This defaults to C<0>.
+
+=item $bool = $e->no_display
+
+=item $e->set_no_display($bool)
+
+Get/Set the C<no_display> attribute. This defaults to C<0>.
+
+=item @plan = $e->sets_plan
+
+Get the plan if this event sets one. The plan is a list of up to 3 items:
+C<($count, $directive, $reason)>. C<$count> must be defined, the others may be
+undef, or may not exist at all.
+
+=item $e->set_sets_plan(\@plan)
+
+Set the plan. You must pass in an arrayref with up to 3 elements.
+
+=item $summary = $e->summary
+
+=item $e->set_summary($summary_or_undef)
+
+Get/Set the summary. This will default to the event package
+C<'Test2::Event::Generic'>. You can set it to any value. Setting this to
+C<undef> will reset it to the default.
+
+=item $int_or_undef = $e->terminate
+
+=item @int_or_empty = $e->terminate
+
+=item $e->set_terminate($int_or_undef)
+
+This will get/set the C<terminate> attribute. This defaults to undef in scalar
+context, or an empty list in list context. Setting this to undef will clear it
+completely. This must be set to a positive integer (0 or larger).
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Info.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Info.pm
new file mode 100755
index 00000000000..51c4bbcd317
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Info.pm
@@ -0,0 +1,127 @@
+package Test2::Event::Info;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed/;
+
+our $VERSION = '1.302073';
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw/diagnostics renderer/;
+
+sub init {
+ my $self = shift;
+
+ my $r = $self->{+RENDERER} or $self->trace->throw("'renderer' is a required attribute");
+
+ return if ref($r) eq 'CODE';
+ return if blessed($r) && $r->can('render');
+
+ $self->trace->throw("renderer '$r' is not a valid renderer, must be a coderef or an object implementing the 'render()' method");
+}
+
+sub render {
+ my $self = shift;
+ my ($fmt) = @_;
+
+ $fmt ||= 'text';
+
+ my $r = $self->{+RENDERER};
+
+ return $r->($fmt) if ref($r) eq 'CODE';
+ return $r->render($fmt);
+}
+
+sub summary { $_[0]->render($_[1] || 'text') }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Info - Info event base class
+
+=head1 DESCRIPTION
+
+Successor for note and diag events. This event base class supports multiple
+formats. This event makes it possible to send additional information such as
+color and highlighting to the harness.
+
+=head1 SYNOPSIS
+
+ use Test2::API::Context qw/context/;
+
+ $ctx->info($obj, diagnostics => $bool);
+
+=head1 FORMATS
+
+Format will be passed in to C<render()> and C<summary()> as a string. Any
+string is considered valid, if your event does not recognize the format it
+should fallback to 'text'.
+
+=over 4
+
+=item 'text'
+
+Plain and ordinary text.
+
+=item 'ansi'
+
+Text that may include ansi sequences such as colors.
+
+=item 'html'
+
+HTML formatted text.
+
+=back
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $bool = $info->diagnostics()
+
+=item $info->set_diagnostics($bool)
+
+True if this info is essential for diagnostics. The implication is that
+diagnostics will got to STDERR while everything else goes to STDOUT, but that
+is formatter/harness specific.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Note.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Note.pm
new file mode 100755
index 00000000000..b9a2ded1e13
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Note.pm
@@ -0,0 +1,81 @@
+package Test2::Event::Note;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw/message/;
+
+sub init {
+ $_[0]->{+MESSAGE} = 'undef' unless defined $_[0]->{+MESSAGE};
+}
+
+sub summary { $_[0]->{+MESSAGE} }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Note - Note event type
+
+=head1 DESCRIPTION
+
+Notes, typically rendered to STDOUT.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Note;
+
+ my $ctx = context();
+ my $event = $ctx->Note($message);
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $note->message
+
+The message for the note.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Ok.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Ok.pm
new file mode 100755
index 00000000000..456d6bbcf3c
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Ok.pm
@@ -0,0 +1,140 @@
+package Test2::Event::Ok;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw{
+ pass effective_pass name todo
+};
+
+sub init {
+ my $self = shift;
+
+ # Do not store objects here, only true or false
+ $self->{+PASS} = $self->{+PASS} ? 1 : 0;
+ $self->{+EFFECTIVE_PASS} = $self->{+PASS} || (defined($self->{+TODO}) ? 1 : 0);
+}
+
+{
+ no warnings 'redefine';
+ sub set_todo {
+ my $self = shift;
+ my ($todo) = @_;
+ $self->{+TODO} = $todo;
+ $self->{+EFFECTIVE_PASS} = defined($todo) ? 1 : $self->{+PASS};
+ }
+}
+
+sub increments_count { 1 };
+
+sub causes_fail { !$_[0]->{+EFFECTIVE_PASS} }
+
+sub summary {
+ my $self = shift;
+
+ my $name = $self->{+NAME} || "Nameless Assertion";
+
+ my $todo = $self->{+TODO};
+ if ($todo) {
+ $name .= " (TODO: $todo)";
+ }
+ elsif (defined $todo) {
+ $name .= " (TODO)"
+ }
+
+ return $name;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Ok - Ok event type
+
+=head1 DESCRIPTION
+
+Ok events are generated whenever you run a test that produces a result.
+Examples are C<ok()>, and C<is()>.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Ok;
+
+ my $ctx = context();
+ my $event = $ctx->ok($bool, $name, \@diag);
+
+or:
+
+ my $ctx = context();
+ my $event = $ctx->send_event(
+ 'Ok',
+ pass => $bool,
+ name => $name,
+ );
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $rb = $e->pass
+
+The original true/false value of whatever was passed into the event (but
+reduced down to 1 or 0).
+
+=item $name = $e->name
+
+Name of the test.
+
+=item $b = $e->effective_pass
+
+This is the true/false value of the test after TODO and similar modifiers are
+taken into account.
+
+=item $b = $e->allow_bad_name
+
+This relaxes the test name checks such that they allow characters that can
+confuse a TAP parser.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Plan.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Plan.pm
new file mode 100755
index 00000000000..94b3030c349
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Plan.pm
@@ -0,0 +1,160 @@
+package Test2::Event::Plan;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw{max directive reason};
+
+use Carp qw/confess/;
+
+my %ALLOWED = (
+ 'SKIP' => 1,
+ 'NO PLAN' => 1,
+);
+
+sub init {
+ if ($_[0]->{+DIRECTIVE}) {
+ $_[0]->{+DIRECTIVE} = 'SKIP' if $_[0]->{+DIRECTIVE} eq 'skip_all';
+ $_[0]->{+DIRECTIVE} = 'NO PLAN' if $_[0]->{+DIRECTIVE} eq 'no_plan';
+
+ confess "'" . $_[0]->{+DIRECTIVE} . "' is not a valid plan directive"
+ unless $ALLOWED{$_[0]->{+DIRECTIVE}};
+ }
+ else {
+ confess "Cannot have a reason without a directive!"
+ if defined $_[0]->{+REASON};
+
+ confess "No number of tests specified"
+ unless defined $_[0]->{+MAX};
+
+ confess "Plan test count '" . $_[0]->{+MAX} . "' does not appear to be a valid positive integer"
+ unless $_[0]->{+MAX} =~ m/^\d+$/;
+
+ $_[0]->{+DIRECTIVE} = '';
+ }
+}
+
+sub sets_plan {
+ my $self = shift;
+ return (
+ $self->{+MAX},
+ $self->{+DIRECTIVE},
+ $self->{+REASON},
+ );
+}
+
+sub callback {
+ my $self = shift;
+ my ($hub) = @_;
+
+ $hub->plan($self->{+DIRECTIVE} || $self->{+MAX});
+
+ return unless $self->{+DIRECTIVE};
+
+ $hub->set_skip_reason($self->{+REASON} || 1) if $self->{+DIRECTIVE} eq 'SKIP';
+}
+
+sub terminate {
+ my $self = shift;
+ # On skip_all we want to terminate the hub
+ return 0 if $self->{+DIRECTIVE} && $self->{+DIRECTIVE} eq 'SKIP';
+ return undef;
+}
+
+sub summary {
+ my $self = shift;
+ my $max = $self->{+MAX};
+ my $directive = $self->{+DIRECTIVE};
+ my $reason = $self->{+REASON};
+
+ return "Plan is $max assertions"
+ if $max || !$directive;
+
+ return "Plan is '$directive', $reason"
+ if $reason;
+
+ return "Plan is '$directive'";
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Plan - The event of a plan
+
+=head1 DESCRIPTION
+
+Plan events are fired off whenever a plan is declared, done testing is called,
+or a subtext completes.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Plan;
+
+ my $ctx = context();
+
+ # Plan for 10 tests to run
+ my $event = $ctx->plan(10);
+
+ # Plan to skip all tests (will exit 0)
+ $ctx->plan(0, skip_all => "These tests need to be skipped");
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $num = $plan->max
+
+Get the number of expected tests
+
+=item $dir = $plan->directive
+
+Get the directive (such as TODO, skip_all, or no_plan).
+
+=item $reason = $plan->reason
+
+Get the reason for the directive.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Skip.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Skip.pm
new file mode 100755
index 00000000000..7cca06165b9
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Skip.pm
@@ -0,0 +1,108 @@
+package Test2::Event::Skip;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
+use Test2::Util::HashBase qw{reason};
+
+sub init {
+ my $self = shift;
+ $self->SUPER::init;
+ $self->{+EFFECTIVE_PASS} = 1;
+}
+
+sub causes_fail { 0 }
+
+sub summary {
+ my $self = shift;
+ my $out = $self->SUPER::summary(@_);
+
+ if (my $reason = $self->reason) {
+ $out .= " (SKIP: $reason)";
+ }
+ else {
+ $out .= " (SKIP)";
+ }
+
+ return $out;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Skip - Skip event type
+
+=head1 DESCRIPTION
+
+Skip events bump test counts just like L<Test2::Event::Ok> events, but
+they can never fail.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Skip;
+
+ my $ctx = context();
+ my $event = $ctx->skip($name, $reason);
+
+or:
+
+ my $ctx = context();
+ my $event = $ctx->send_event(
+ 'Skip',
+ name => $name,
+ reason => $reason,
+ );
+
+=head1 ACCESSORS
+
+=over 4
+
+=item $reason = $e->reason
+
+The original true/false value of whatever was passed into the event (but
+reduced down to 1 or 0).
+
+=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 2016 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://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
new file mode 100755
index 00000000000..2b3c773bf67
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
@@ -0,0 +1,131 @@
+package Test2::Event::Subtest;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
+use Test2::Util::HashBase qw{subevents buffered subtest_id};
+
+sub init {
+ my $self = shift;
+ $self->SUPER::init();
+ $self->{+SUBEVENTS} ||= [];
+ if ($self->{+EFFECTIVE_PASS}) {
+ $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}};
+ }
+}
+
+{
+ no warnings 'redefine';
+
+ sub set_subevents {
+ my $self = shift;
+ my @subevents = @_;
+
+ if ($self->{+EFFECTIVE_PASS}) {
+ $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @subevents;
+ }
+
+ $self->{+SUBEVENTS} = \@subevents;
+ }
+
+ sub set_effective_pass {
+ my $self = shift;
+ my ($pass) = @_;
+
+ if ($pass) {
+ $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}};
+ }
+ elsif ($self->{+EFFECTIVE_PASS} && !$pass) {
+ for my $s (grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}}) {
+ $_->set_effective_pass(0) unless $s->can('todo') && defined $s->todo;
+ }
+ }
+
+ $self->{+EFFECTIVE_PASS} = $pass;
+ }
+}
+
+sub summary {
+ my $self = shift;
+
+ my $name = $self->{+NAME} || "Nameless Subtest";
+
+ my $todo = $self->{+TODO};
+ if ($todo) {
+ $name .= " (TODO: $todo)";
+ }
+ elsif (defined $todo) {
+ $name .= " (TODO)"
+ }
+
+ return $name;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Subtest - Event for subtest types
+
+=head1 DESCRIPTION
+
+This class represents a subtest. This class is a subclass of
+L<Test2::Event::Ok>.
+
+=head1 ACCESSORS
+
+This class inherits from L<Test2::Event::Ok>.
+
+=over 4
+
+=item $arrayref = $e->subevents
+
+Returns the arrayref containing all the events from the subtest
+
+=item $bool = $e->buffered
+
+True if the subtest is buffered, that is all subevents render at once. If this
+is false it means all subevents render as they are produced.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm b/Master/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm
new file mode 100755
index 00000000000..b96a25adde4
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm
@@ -0,0 +1,83 @@
+package Test2::Event::TAP::Version;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw/version/;
+
+sub init {
+ my $self = shift;
+ defined $self->{+VERSION} or $self->trace->throw("'version' is a required attribute");
+}
+
+sub summary { 'TAP version ' . $_[0]->{+VERSION} }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::TAP::Version - Event for TAP version.
+
+=head1 DESCRIPTION
+
+This event is used if a TAP formatter wishes to set a version.
+
+=head1 SYNOPSIS
+
+ use Test2::API qw/context/;
+ use Test2::Event::Encoding;
+
+ my $ctx = context();
+ my $event = $ctx->send_event('TAP::Version', version => 42);
+
+=head1 METHODS
+
+Inherits from L<Test2::Event>. Also defines:
+
+=over 4
+
+=item $version = $e->version
+
+The TAP version being parsed.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Event/Waiting.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Waiting.pm
new file mode 100755
index 00000000000..fa87c6e8dd7
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Waiting.pm
@@ -0,0 +1,61 @@
+package Test2::Event::Waiting;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+
+sub global { 1 };
+
+sub summary { "IPC is waiting for children to finish..." }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Event::Waiting - Tell all procs/threads it is time to be done
+
+=head1 DESCRIPTION
+
+This event has no data of its own. This event is sent out by the IPC system
+when the main process/thread is ready to end.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Formatter.pm b/Master/tlpkg/tlperl/lib/Test2/Formatter.pm
new file mode 100755
index 00000000000..945d545dd65
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Formatter.pm
@@ -0,0 +1,128 @@
+package Test2::Formatter;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+my %ADDED;
+sub import {
+ my $class = shift;
+ return if $class eq __PACKAGE__;
+ return if $ADDED{$class}++;
+ require Test2::API;
+ Test2::API::test2_formatter_add($class);
+}
+
+sub hide_buffered { 1 }
+
+sub terminate { }
+
+sub finalize { }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Formatter - Namespace for formatters.
+
+=head1 DESCRIPTION
+
+This is the namespace for formatters. This is an empty package.
+
+=head1 CREATING FORMATTERS
+
+A formatter is any package or object with a C<write($event, $num)> method.
+
+ package Test2::Formatter::Foo;
+ use strict;
+ use warnings;
+
+ sub write {
+ my $self_or_class = shift;
+ my ($event, $assert_num) = @_;
+ ...
+ }
+
+ sub hide_buffered { 1 }
+
+ sub terminate { }
+
+ sub finalize { }
+
+ 1;
+
+The C<write> method is a method, so it either gets a class or instance. The two
+arguments are the C<$event> object it should record, and the C<$assert_num>
+which is the number of the current assertion (ok), or the last assertion if
+this even is not itself an assertion. The assertion number may be any integer 0
+or greater, and may be undefined in some cases.
+
+The C<hide_buffered()> method must return a boolean. This is used to tell
+buffered subtests whether or not to send it events as they are being buffered.
+See L<Test2::API/"run_subtest(...)"> for more information.
+
+The C<terminate> and C<finalize> methods are optional methods called that you
+can implement if the format you're generating needs to handle these cases, for
+example if you are generating XML and need close open tags.
+
+The C<terminate> method is called when an event's C<terminate> method returns
+true, for example when a L<Test2::Event::Plan> has a C<'skip_all'> plan, or
+when a L<Test2::Event::Bail> event is sent. The C<terminate> method is passed
+a single argument, the L<Test2::Event> object which triggered the terminate.
+
+The C<finalize> method is always the last thing called on the formatter, I<<
+except when C<terminate> is called for a Bail event >>. It is passed the
+following arguments:
+
+=over 4
+
+=item * The number of tests that were planned
+
+=item * The number of tests actually seen
+
+=item * The number of tests which failed
+
+=item * A boolean indicating whether or not the test suite passed
+
+=item * A boolean indicating whether or not this call is for a subtest
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm b/Master/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm
new file mode 100755
index 00000000000..680095cfede
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Formatter/TAP.pm
@@ -0,0 +1,538 @@
+package Test2::Formatter::TAP;
+use strict;
+use warnings;
+require PerlIO;
+
+our $VERSION = '1.302073';
+
+use Test2::Util::HashBase qw{
+ no_numbers handles _encoding
+};
+
+sub OUT_STD() { 0 }
+sub OUT_ERR() { 1 }
+
+use Carp qw/croak/;
+
+BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) }
+
+my %CONVERTERS = (
+ 'Test2::Event::Ok' => 'event_ok',
+ 'Test2::Event::Skip' => 'event_skip',
+ 'Test2::Event::Note' => 'event_note',
+ 'Test2::Event::Diag' => 'event_diag',
+ 'Test2::Event::Bail' => 'event_bail',
+ 'Test2::Event::Exception' => 'event_exception',
+ 'Test2::Event::Subtest' => 'event_subtest',
+ 'Test2::Event::Plan' => 'event_plan',
+ 'Test2::Event::TAP::Version' => 'event_version',
+);
+
+# Initial list of converters are safe for direct hash access cause we control them.
+my %SAFE_TO_ACCESS_HASH = %CONVERTERS;
+
+sub register_event {
+ my $class = shift;
+ my ($type, $convert) = @_;
+ croak "Event type is a required argument" unless $type;
+ croak "Event type '$type' already registered" if $CONVERTERS{$type};
+ croak "The second argument to register_event() must be a code reference or method name"
+ unless $convert && (ref($convert) eq 'CODE' || $class->can($convert));
+ $CONVERTERS{$type} = $convert;
+}
+
+_autoflush(\*STDOUT);
+_autoflush(\*STDERR);
+
+sub init {
+ my $self = shift;
+
+ $self->{+HANDLES} ||= $self->_open_handles;
+ if(my $enc = delete $self->{encoding}) {
+ $self->encoding($enc);
+ }
+}
+
+sub hide_buffered { 1 }
+
+sub encoding {
+ my $self = shift;
+
+ if (@_) {
+ my ($enc) = @_;
+ my $handles = $self->{+HANDLES};
+
+ # https://rt.perl.org/Public/Bug/Display.html?id=31923
+ # If utf8 is requested we use ':utf8' instead of ':encoding(utf8)' in
+ # order to avoid the thread segfault.
+ if ($enc =~ m/^utf-?8$/i) {
+ binmode($_, ":utf8") for @$handles;
+ }
+ else {
+ binmode($_, ":encoding($enc)") for @$handles;
+ }
+ $self->{+_ENCODING} = $enc;
+ }
+
+ return $self->{+_ENCODING};
+}
+
+if ($^C) {
+ no warnings 'redefine';
+ *write = sub {};
+}
+sub write {
+ my ($self, $e, $num) = @_;
+
+ my $type = ref($e);
+
+ my $converter = $CONVERTERS{$type} || 'event_other';
+ my @tap = $self->$converter($e, $self->{+NO_NUMBERS} ? undef : $num) or return;
+
+ my $handles = $self->{+HANDLES};
+ my $nesting = ($SAFE_TO_ACCESS_HASH{$type} ? $e->{nested} : $e->nested) || 0;
+ my $indent = ' ' x $nesting;
+
+ # Local is expensive! Only do it if we really need to.
+ local($\, $,) = (undef, '') if $\ || $,;
+ for my $set (@tap) {
+ no warnings 'uninitialized';
+ my ($hid, $msg) = @$set;
+ next unless $msg;
+ my $io = $handles->[$hid] or next;
+
+ $msg =~ s/^/$indent/mg if $nesting;
+ print $io $msg;
+ }
+}
+
+sub _open_handles {
+ my $self = shift;
+
+ my %seen;
+ open(my $out, '>&', STDOUT) or die "Can't dup STDOUT: $!";
+ binmode($out, join(":", "", "raw", grep { $_ ne 'unix' and !$seen{$_}++ } PerlIO::get_layers(STDOUT)));
+
+ %seen = ();
+ open(my $err, '>&', STDERR) or die "Can't dup STDERR: $!";
+ binmode($err, join(":", "", "raw", grep { $_ ne 'unix' and !$seen{$_}++ } PerlIO::get_layers(STDERR)));
+
+ _autoflush($out);
+ _autoflush($err);
+
+ return [$out, $err];
+}
+
+sub _autoflush {
+ my($fh) = pop;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+}
+
+sub event_tap {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ my $converter = $CONVERTERS{ref($e)} or return;
+
+ $num = undef if $self->{+NO_NUMBERS};
+
+ return $self->$converter($e, $num);
+}
+
+sub event_ok {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ # We use direct hash access for performance. OK events are so common we
+ # need this to be fast.
+ my ($name, $todo) = @{$e}{qw/name todo/};
+ my $in_todo = defined($todo);
+
+ my $out = "";
+ $out .= "not " unless $e->{pass};
+ $out .= "ok";
+ $out .= " $num" if defined($num);
+
+ # The regex form is ~250ms, the index form is ~50ms
+ my @extra;
+ defined($name) && (
+ (index($name, "\n") != -1 && (($name, @extra) = split(/\n\r?/, $name, -1))),
+ ((index($name, "#" ) != -1 || substr($name, -1) eq '\\') && (($name =~ s|\\|\\\\|g), ($name =~ s|#|\\#|g)))
+ );
+
+ my $space = @extra ? ' ' x (length($out) + 2) : '';
+
+ $out .= " - $name" if defined $name;
+ $out .= " # TODO" if $in_todo;
+ $out .= " $todo" if defined($todo) && length($todo);
+
+ # The primary line of TAP, if the test passed this is all we need.
+ return([OUT_STD, "$out\n"]) unless @extra;
+
+ return $self->event_ok_multiline($out, $space, @extra);
+}
+
+sub event_ok_multiline {
+ my $self = shift;
+ my ($out, $space, @extra) = @_;
+
+ return(
+ [OUT_STD, "$out\n"],
+ map {[OUT_STD, "#${space}$_\n"]} @extra,
+ );
+}
+
+sub event_skip {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ my $name = $e->name;
+ my $reason = $e->reason;
+ my $todo = $e->todo;
+
+ my $out = "";
+ $out .= "not " unless $e->{pass};
+ $out .= "ok";
+ $out .= " $num" if defined $num;
+ $out .= " - $name" if $name;
+ if (defined($todo)) {
+ $out .= " # TODO & SKIP"
+ }
+ else {
+ $out .= " # skip";
+ }
+ $out .= " $reason" if defined($reason) && length($reason);
+
+ return([OUT_STD, "$out\n"]);
+}
+
+sub event_note {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ chomp(my $msg = $e->message);
+ $msg =~ s/^/# /;
+ $msg =~ s/\n/\n# /g;
+
+ return [OUT_STD, "$msg\n"];
+}
+
+sub event_diag {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ chomp(my $msg = $e->message);
+ $msg =~ s/^/# /;
+ $msg =~ s/\n/\n# /g;
+
+ return [OUT_ERR, "$msg\n"];
+}
+
+sub event_bail {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ return if $e->nested;
+
+ return [
+ OUT_STD,
+ "Bail out! " . $e->reason . "\n",
+ ];
+}
+
+sub event_exception {
+ my $self = shift;
+ my ($e, $num) = @_;
+ return [ OUT_ERR, $e->error ];
+}
+
+sub event_subtest {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ # A 'subtest' is a subclass of 'ok'. Let the code that renders 'ok' render
+ # this event.
+ my ($ok, @diag) = $self->event_ok($e, $num);
+
+ # If the subtest is not buffered then the sub-events have already been
+ # rendered, we can go ahead and return.
+ return ($ok, @diag) unless $e->buffered;
+
+ # In a verbose harness we indent the diagnostics from the 'Ok' event since
+ # they will appear inside the subtest braces. This helps readability. In a
+ # non-verbose harness we do not do this because it is less readable.
+ if ($ENV{HARNESS_IS_VERBOSE}) {
+ # index 0 is the filehandle, index 1 is the message we want to indent.
+ $_->[1] =~ s/^(.*\S.*)$/ $1/mg for @diag;
+ }
+
+ # Add the trailing ' {' to the 'ok' line of TAP output.
+ $ok->[1] =~ s/\n/ {\n/;
+
+ # Render the sub-events, we use our own counter for these.
+ my $count = 0;
+ my @subs = map {
+ # Bump the count for any event that should bump it.
+ $count++ if $_->increments_count;
+
+ # This indents all output lines generated for the sub-events.
+ # index 0 is the filehandle, index 1 is the message we want to indent.
+ map { $_->[1] =~ s/^(.*\S.*)$/ $1/mg; $_ } $self->event_tap($_, $count);
+ } @{$e->subevents};
+
+ return (
+ $ok, # opening ok - name {
+ @diag, # diagnostics if the subtest failed
+ @subs, # All the inner-event lines
+ [OUT_STD(), "}\n"], # } (closing brace)
+ );
+}
+
+sub event_plan {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ my $directive = $e->directive;
+ return if $directive && $directive eq 'NO PLAN';
+
+ my $reason = $e->reason;
+ $reason =~ s/\n/\n# /g if $reason;
+
+ my $plan = "1.." . $e->max;
+ if ($directive) {
+ $plan .= " # $directive";
+ $plan .= " $reason" if defined $reason;
+ }
+
+ return [OUT_STD, "$plan\n"];
+}
+
+sub event_version {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ my $version = $e->version;
+
+ return [OUT_STD, "TAP version $version\n"];
+}
+
+sub event_other {
+ my $self = shift;
+ my ($e, $num) = @_;
+ return if $e->no_display;
+
+ my @out;
+
+ if (my ($max, $directive, $reason) = $e->sets_plan) {
+ my $plan = "1..$max";
+ $plan .= " # $directive" if $directive;
+ $plan .= " $reason" if defined $reason;
+ push @out => [OUT_STD, "$plan\n"];
+ }
+
+ if ($e->increments_count) {
+ my $ok = "";
+ $ok .= "not " if $e->causes_fail;
+ $ok .= "ok";
+ $ok .= " $num" if defined($num);
+ $ok .= " - " . $e->summary if $e->summary;
+
+ push @out => [OUT_STD, "$ok\n"];
+ }
+ else { # Comment
+ my $handle = ($e->causes_fail || $e->diagnostics) ? OUT_ERR : OUT_STD;
+ my $summary = $e->summary || ref($e);
+ chomp($summary);
+ $summary =~ s/^/# /smg;
+ push @out => [$handle, "$summary\n"];
+ }
+
+ return @out;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Formatter::TAP - Standard TAP formatter
+
+=head1 DESCRIPTION
+
+This is what takes events and turns them into TAP.
+
+=head1 SYNOPSIS
+
+ use Test2::Formatter::TAP;
+ my $tap = Test2::Formatter::TAP->new();
+
+ # Switch to utf8
+ $tap->encoding('utf8');
+
+ $tap->write($event, $number); # Output an event
+
+=head1 METHODS
+
+=over 4
+
+=item $bool = $tap->no_numbers
+
+=item $tap->set_no_numbers($bool)
+
+Use to turn numbers on and off.
+
+=item $arrayref = $tap->handles
+
+=item $tap->set_handles(\@handles);
+
+Can be used to get/set the filehandles. Indexes are identified by the
+C<OUT_STD> and C<OUT_ERR> constants.
+
+=item $encoding = $tap->encoding
+
+=item $tap->encoding($encoding)
+
+Get or set the encoding. By default no encoding is set, the original settings
+of STDOUT and STDERR are used.
+
+This directly modifies the stored filehandles, it does not create new ones.
+
+=item $tap->write($e, $num)
+
+Write an event to the console.
+
+=item Test2::Formatter::TAP->register_event($pkg, sub { ... });
+
+In general custom events are not supported. There are however occasions where
+you might want to write a custom event type that results in TAP output. In
+order to do this you use the C<register_event()> class method.
+
+ package My::Event;
+ use Test2::Formatter::TAP;
+
+ use base 'Test2::Event';
+ use Test2::Util::HashBase qw/pass name diag note/;
+
+ Test2::Formatter::TAP->register_event(
+ __PACKAGE__,
+ sub {
+ my $self = shift;
+ my ($e, $num) = @_;
+ return (
+ [Test2::Formatter::TAP::OUT_STD, "ok $num - " . $e->name . "\n"],
+ [Test2::Formatter::TAP::OUT_ERR, "# " . $e->name . " " . $e->diag . "\n"],
+ [Test2::Formatter::TAP::OUT_STD, "# " . $e->name . " " . $e->note . "\n"],
+ );
+ }
+ );
+
+ 1;
+
+=back
+
+=head2 EVENT METHODS
+
+All these methods require the event itself. Optionally they can all except a
+test number.
+
+All methods return a list of array-refs. Each array-ref will have 2 items, the
+first is an integer identifying an output handle, the second is a string that
+should be written to the handle.
+
+=over 4
+
+=item @out = $TAP->event_ok($e)
+
+=item @out = $TAP->event_ok($e, $num)
+
+Process an L<Test2::Event::Ok> event.
+
+=item @out = $TAP->event_plan($e)
+
+=item @out = $TAP->event_plan($e, $num)
+
+Process an L<Test2::Event::Plan> event.
+
+=item @out = $TAP->event_note($e)
+
+=item @out = $TAP->event_note($e, $num)
+
+Process an L<Test2::Event::Note> event.
+
+=item @out = $TAP->event_diag($e)
+
+=item @out = $TAP->event_diag($e, $num)
+
+Process an L<Test2::Event::Diag> event.
+
+=item @out = $TAP->event_bail($e)
+
+=item @out = $TAP->event_bail($e, $num)
+
+Process an L<Test2::Event::Bail> event.
+
+=item @out = $TAP->event_exception($e)
+
+=item @out = $TAP->event_exception($e, $num)
+
+Process an L<Test2::Event::Exception> event.
+
+=item @out = $TAP->event_skip($e)
+
+=item @out = $TAP->event_skip($e, $num)
+
+Process an L<Test2::Event::Skip> event.
+
+=item @out = $TAP->event_subtest($e)
+
+=item @out = $TAP->event_subtest($e, $num)
+
+Process an L<Test2::Event::Subtest> event.
+
+=item @out = $TAP->event_other($e, $num)
+
+Fallback for unregistered event types. It uses the L<Test2::Event> API to
+convert the event to TAP.
+
+=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>
+
+=item Kent Fredric E<lt>kentnl@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 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/Master/tlpkg/tlperl/lib/Test2/Hub.pm b/Master/tlpkg/tlperl/lib/Test2/Hub.pm
new file mode 100755
index 00000000000..324f1a87bbb
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Hub.pm
@@ -0,0 +1,829 @@
+package Test2::Hub;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Carp qw/carp croak confess/;
+use Test2::Util qw/get_tid ipc_separator/;
+
+use Scalar::Util qw/weaken/;
+
+use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
+use Test2::Util::HashBase qw{
+ pid tid hid ipc
+ no_ending
+ _filters
+ _pre_filters
+ _listeners
+ _follow_ups
+ _formatter
+ _context_acquire
+ _context_init
+ _context_release
+
+ active
+ count
+ failed
+ ended
+ bailed_out
+ _passing
+ _plan
+ skip_reason
+};
+
+my $ID_POSTFIX = 1;
+sub init {
+ my $self = shift;
+
+ $self->{+PID} = $$;
+ $self->{+TID} = get_tid();
+ $self->{+HID} = join ipc_separator, $self->{+PID}, $self->{+TID}, $ID_POSTFIX++;
+
+ $self->{+COUNT} = 0;
+ $self->{+FAILED} = 0;
+ $self->{+_PASSING} = 1;
+
+ if (my $formatter = delete $self->{formatter}) {
+ $self->format($formatter);
+ }
+
+ if (my $ipc = $self->{+IPC}) {
+ $ipc->add_hub($self->{+HID});
+ }
+}
+
+sub is_subtest { 0 }
+
+sub reset_state {
+ my $self = shift;
+
+ $self->{+COUNT} = 0;
+ $self->{+FAILED} = 0;
+ $self->{+_PASSING} = 1;
+
+ delete $self->{+_PLAN};
+ delete $self->{+ENDED};
+ delete $self->{+BAILED_OUT};
+ delete $self->{+SKIP_REASON};
+}
+
+sub inherit {
+ my $self = shift;
+ my ($from, %params) = @_;
+
+ $self->{+_FORMATTER} = $from->{+_FORMATTER}
+ unless $self->{+_FORMATTER} || exists($params{formatter});
+
+ if ($from->{+IPC} && !$self->{+IPC} && !exists($params{ipc})) {
+ my $ipc = $from->{+IPC};
+ $self->{+IPC} = $ipc;
+ $ipc->add_hub($self->{+HID});
+ }
+
+ if (my $ls = $from->{+_LISTENERS}) {
+ push @{$self->{+_LISTENERS}} => grep { $_->{inherit} } @$ls;
+ }
+
+ if (my $pfs = $from->{+_PRE_FILTERS}) {
+ push @{$self->{+_PRE_FILTERS}} => grep { $_->{inherit} } @$pfs;
+ }
+
+ if (my $fs = $from->{+_FILTERS}) {
+ push @{$self->{+_FILTERS}} => grep { $_->{inherit} } @$fs;
+ }
+}
+
+sub format {
+ my $self = shift;
+
+ my $old = $self->{+_FORMATTER};
+ ($self->{+_FORMATTER}) = @_ if @_;
+
+ return $old;
+}
+
+sub is_local {
+ my $self = shift;
+ return $$ == $self->{+PID}
+ && get_tid() == $self->{+TID};
+}
+
+sub listen {
+ my $self = shift;
+ my ($sub, %params) = @_;
+
+ carp "Useless addition of a listener in a child process or thread!"
+ if $$ != $self->{+PID} || get_tid() != $self->{+TID};
+
+ croak "listen only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->{+_LISTENERS}} => { %params, code => $sub };
+
+ $sub; # Intentional return.
+}
+
+sub unlisten {
+ my $self = shift;
+
+ carp "Useless removal of a listener in a child process or thread!"
+ if $$ != $self->{+PID} || get_tid() != $self->{+TID};
+
+ my %subs = map {$_ => $_} @_;
+
+ @{$self->{+_LISTENERS}} = grep { !$subs{$_->{code}} } @{$self->{+_LISTENERS}};
+}
+
+sub filter {
+ my $self = shift;
+ my ($sub, %params) = @_;
+
+ carp "Useless addition of a filter in a child process or thread!"
+ if $$ != $self->{+PID} || get_tid() != $self->{+TID};
+
+ croak "filter only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->{+_FILTERS}} => { %params, code => $sub };
+
+ $sub; # Intentional Return
+}
+
+sub unfilter {
+ my $self = shift;
+ carp "Useless removal of a filter in a child process or thread!"
+ if $$ != $self->{+PID} || get_tid() != $self->{+TID};
+ my %subs = map {$_ => $_} @_;
+ @{$self->{+_FILTERS}} = grep { !$subs{$_->{code}} } @{$self->{+_FILTERS}};
+}
+
+sub pre_filter {
+ my $self = shift;
+ my ($sub, %params) = @_;
+
+ croak "pre_filter only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->{+_PRE_FILTERS}} => { %params, code => $sub };
+
+ $sub; # Intentional Return
+}
+
+sub pre_unfilter {
+ my $self = shift;
+ my %subs = map {$_ => $_} @_;
+ @{$self->{+_PRE_FILTERS}} = grep { !$subs{$_->{code}} } @{$self->{+_PRE_FILTERS}};
+}
+
+sub follow_up {
+ my $self = shift;
+ my ($sub) = @_;
+
+ carp "Useless addition of a follow-up in a child process or thread!"
+ if $$ != $self->{+PID} || get_tid() != $self->{+TID};
+
+ croak "follow_up only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->{+_FOLLOW_UPS}} => $sub;
+}
+
+*add_context_aquire = \&add_context_acquire;
+sub add_context_acquire {
+ my $self = shift;
+ my ($sub) = @_;
+
+ croak "add_context_acquire only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->{+_CONTEXT_ACQUIRE}} => $sub;
+
+ $sub; # Intentional return.
+}
+
+*remove_context_aquire = \&remove_context_acquire;
+sub remove_context_acquire {
+ my $self = shift;
+ my %subs = map {$_ => $_} @_;
+ @{$self->{+_CONTEXT_ACQUIRE}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_ACQUIRE}};
+}
+
+sub add_context_init {
+ my $self = shift;
+ my ($sub) = @_;
+
+ croak "add_context_init only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->{+_CONTEXT_INIT}} => $sub;
+
+ $sub; # Intentional return.
+}
+
+sub remove_context_init {
+ my $self = shift;
+ my %subs = map {$_ => $_} @_;
+ @{$self->{+_CONTEXT_INIT}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_INIT}};
+}
+
+sub add_context_release {
+ my $self = shift;
+ my ($sub) = @_;
+
+ croak "add_context_release only takes coderefs for arguments, got '$sub'"
+ unless ref $sub && ref $sub eq 'CODE';
+
+ push @{$self->{+_CONTEXT_RELEASE}} => $sub;
+
+ $sub; # Intentional return.
+}
+
+sub remove_context_release {
+ my $self = shift;
+ my %subs = map {$_ => $_} @_;
+ @{$self->{+_CONTEXT_RELEASE}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_RELEASE}};
+}
+
+sub send {
+ my $self = shift;
+ my ($e) = @_;
+
+ if ($self->{+_PRE_FILTERS}) {
+ for (@{$self->{+_PRE_FILTERS}}) {
+ $e = $_->{code}->($self, $e);
+ return unless $e;
+ }
+ }
+
+ my $ipc = $self->{+IPC} || return $self->process($e);
+
+ if($e->global) {
+ $ipc->send($self->{+HID}, $e, 'GLOBAL');
+ return $self->process($e);
+ }
+
+ return $ipc->send($self->{+HID}, $e)
+ if $$ != $self->{+PID} || get_tid() != $self->{+TID};
+
+ $self->process($e);
+}
+
+sub process {
+ my $self = shift;
+ my ($e) = @_;
+
+ if ($self->{+_FILTERS}) {
+ for (@{$self->{+_FILTERS}}) {
+ $e = $_->{code}->($self, $e);
+ return unless $e;
+ }
+ }
+
+ my $type = ref($e);
+ my $is_ok = $type eq 'Test2::Event::Ok';
+ my $no_fail = $type eq 'Test2::Event::Diag' || $type eq 'Test2::Event::Note';
+ my $causes_fail = $is_ok ? !$e->{effective_pass} : $no_fail ? 0 : $e->causes_fail;
+ my $counted = $is_ok || (!$no_fail && $e->increments_count);
+
+ $self->{+COUNT}++ if $counted;
+ $self->{+FAILED}++ if $causes_fail && $counted;
+ $self->{+_PASSING} = 0 if $causes_fail;
+
+ my $callback = $e->callback($self) unless $is_ok || $no_fail;
+
+ my $count = $self->{+COUNT};
+
+ $self->{+_FORMATTER}->write($e, $count) if $self->{+_FORMATTER};
+
+ if ($self->{+_LISTENERS}) {
+ $_->{code}->($self, $e, $count) for @{$self->{+_LISTENERS}};
+ }
+
+ return $e if $is_ok || $no_fail;
+
+ my $code = $e->terminate;
+ if (defined $code) {
+ $self->{+_FORMATTER}->terminate($e) if $self->{+_FORMATTER};
+ $self->terminate($code, $e);
+ }
+
+ return $e;
+}
+
+sub terminate {
+ my $self = shift;
+ my ($code) = @_;
+ exit($code);
+}
+
+sub cull {
+ my $self = shift;
+
+ my $ipc = $self->{+IPC} || return;
+ return if $self->{+PID} != $$ || $self->{+TID} != get_tid();
+
+ # No need to do IPC checks on culled events
+ $self->process($_) for $ipc->cull($self->{+HID});
+}
+
+sub finalize {
+ my $self = shift;
+ my ($trace, $do_plan) = @_;
+
+ $self->cull();
+
+ my $plan = $self->{+_PLAN};
+ my $count = $self->{+COUNT};
+ my $failed = $self->{+FAILED};
+ my $active = $self->{+ACTIVE};
+
+ # return if NOTHING was done.
+ unless ($active || $do_plan || defined($plan) || $count || $failed) {
+ $self->{+_FORMATTER}->finalize($plan, $count, $failed, 0, $self->is_subtest) if $self->{+_FORMATTER};
+ return;
+ }
+
+ unless ($self->{+ENDED}) {
+ if ($self->{+_FOLLOW_UPS}) {
+ $_->($trace, $self) for reverse @{$self->{+_FOLLOW_UPS}};
+ }
+
+ # These need to be refreshed now
+ $plan = $self->{+_PLAN};
+ $count = $self->{+COUNT};
+ $failed = $self->{+FAILED};
+
+ if (($plan && $plan eq 'NO PLAN') || ($do_plan && !$plan)) {
+ $self->send(
+ Test2::Event::Plan->new(
+ trace => $trace,
+ max => $count,
+ )
+ );
+ }
+ $plan = $self->{+_PLAN};
+ }
+
+ my $frame = $trace->frame;
+ if($self->{+ENDED}) {
+ my (undef, $ffile, $fline) = @{$self->{+ENDED}};
+ my (undef, $sfile, $sline) = @$frame;
+
+ die <<" EOT"
+Test already ended!
+First End: $ffile line $fline
+Second End: $sfile line $sline
+ EOT
+ }
+
+ $self->{+ENDED} = $frame;
+ my $pass = $self->is_passing(); # Generate the final boolean.
+
+ $self->{+_FORMATTER}->finalize($plan, $count, $failed, $pass, $self->is_subtest) if $self->{+_FORMATTER};
+
+ return $pass;
+}
+
+sub is_passing {
+ my $self = shift;
+
+ ($self->{+_PASSING}) = @_ if @_;
+
+ # If we already failed just return 0.
+ my $pass = $self->{+_PASSING} or return 0;
+ return $self->{+_PASSING} = 0 if $self->{+FAILED};
+
+ my $count = $self->{+COUNT};
+ my $ended = $self->{+ENDED};
+ my $plan = $self->{+_PLAN};
+
+ return $pass if !$count && $plan && $plan =~ m/^SKIP$/;
+
+ return $self->{+_PASSING} = 0
+ if $ended && (!$count || !$plan);
+
+ return $pass unless $plan && $plan =~ m/^\d+$/;
+
+ if ($ended) {
+ return $self->{+_PASSING} = 0 if $count != $plan;
+ }
+ else {
+ return $self->{+_PASSING} = 0 if $count > $plan;
+ }
+
+ return $pass;
+}
+
+sub plan {
+ my $self = shift;
+
+ return $self->{+_PLAN} unless @_;
+
+ my ($plan) = @_;
+
+ confess "You cannot unset the plan"
+ unless defined $plan;
+
+ confess "You cannot change the plan"
+ if $self->{+_PLAN} && $self->{+_PLAN} !~ m/^NO PLAN$/;
+
+ confess "'$plan' is not a valid plan! Plan must be an integer greater than 0, 'NO PLAN', or 'SKIP'"
+ unless $plan =~ m/^(\d+|NO PLAN|SKIP)$/;
+
+ $self->{+_PLAN} = $plan;
+}
+
+sub check_plan {
+ my $self = shift;
+
+ return undef unless $self->{+ENDED};
+ my $plan = $self->{+_PLAN} || return undef;
+
+ return 1 if $plan !~ m/^\d+$/;
+
+ return 1 if $plan == $self->{+COUNT};
+ return 0;
+}
+
+sub DESTROY {
+ my $self = shift;
+ my $ipc = $self->{+IPC} || return;
+ return unless $$ == $self->{+PID};
+ return unless get_tid() == $self->{+TID};
+
+ $ipc->drop_hub($self->{+HID});
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Hub - The conduit through which all events flow.
+
+=head1 SYNOPSIS
+
+ use Test2::Hub;
+
+ my $hub = Test2::Hub->new();
+ $hub->send(...);
+
+=head1 DESCRIPTION
+
+The hub is the place where all events get processed and handed off to the
+formatter. The hub also tracks test state, and provides several hooks into the
+event pipeline.
+
+=head1 COMMON TASKS
+
+=head2 SENDING EVENTS
+
+ $hub->send($event)
+
+The C<send()> method is used to issue an event to the hub. This method will
+handle thread/fork sync, filters, listeners, TAP output, etc.
+
+=head2 ALTERING OR REMOVING EVENTS
+
+You can use either C<filter()> or C<pre_filter()>, depending on your
+needs. Both have identical syntax, so only C<filter()> is shown here.
+
+ $hub->filter(sub {
+ my ($hub, $event) = @_;
+
+ my $action = get_action($event);
+
+ # No action should be taken
+ return $event if $action eq 'none';
+
+ # You want your filter to remove the event
+ return undef if $action eq 'delete';
+
+ if ($action eq 'do_it') {
+ my $new_event = copy_event($event);
+ ... Change your copy of the event ...
+ return $new_event;
+ }
+
+ die "Should not happen";
+ });
+
+By default, filters are not inherited by child hubs. That means if you start a
+subtest, the subtest will not inherit the filter. You can change this behavior
+with the C<inherit> parameter:
+
+ $hub->filter(sub { ... }, inherit => 1);
+
+=head2 LISTENING FOR EVENTS
+
+ $hub->listen(sub {
+ my ($hub, $event, $number) = @_;
+
+ ... do whatever you want with the event ...
+
+ # return is ignored
+ });
+
+By default listeners are not inherited by child hubs. That means if you start a
+subtest, the subtest will not inherit the listener. You can change this behavior
+with the C<inherit> parameter:
+
+ $hub->listen(sub { ... }, inherit => 1);
+
+
+=head2 POST-TEST BEHAVIORS
+
+ $hub->follow_up(sub {
+ my ($trace, $hub) = @_;
+
+ ... do whatever you need to ...
+
+ # Return is ignored
+ });
+
+follow_up subs are called only once, either when done_testing is called, or in
+an END block.
+
+=head2 SETTING THE FORMATTER
+
+By default an instance of L<Test2::Formatter::TAP> is created and used.
+
+ my $old = $hub->format(My::Formatter->new);
+
+Setting the formatter will REPLACE any existing formatter. You may set the
+formatter to undef to prevent output. The old formatter will be returned if one
+was already set. Only one formatter is allowed at a time.
+
+=head1 METHODS
+
+=over 4
+
+=item $hub->send($event)
+
+This is where all events enter the hub for processing.
+
+=item $hub->process($event)
+
+This is called by send after it does any IPC handling. You can use this to
+bypass the IPC process, but in general you should avoid using this.
+
+=item $old = $hub->format($formatter)
+
+Replace the existing formatter instance with a new one. Formatters must be
+objects that implement a C<< $formatter->write($event) >> method.
+
+=item $sub = $hub->listen(sub { ... }, %optional_params)
+
+You can use this to record all events AFTER they have been sent to the
+formatter. No changes made here will be meaningful, except possibly to other
+listeners.
+
+ $hub->listen(sub {
+ my ($hub, $event, $number) = @_;
+
+ ... do whatever you want with the event ...
+
+ # return is ignored
+ });
+
+Normally listeners are not inherited by child hubs such as subtests. You can
+add the C<< inherit => 1 >> parameter to allow a listener to be inherited.
+
+=item $hub->unlisten($sub)
+
+You can use this to remove a listen callback. You must pass in the coderef
+returned by the C<listen()> method.
+
+=item $sub = $hub->filter(sub { ... }, %optional_params)
+
+=item $sub = $hub->pre_filter(sub { ... }, %optional_params)
+
+These can be used to add filters. Filters can modify, replace, or remove events
+before anything else can see them.
+
+ $hub->filter(
+ sub {
+ my ($hub, $event) = @_;
+
+ return $event; # No Changes
+ return; # Remove the event
+
+ # Or you can modify an event before returning it.
+ $event->modify;
+ return $event;
+ }
+ );
+
+If you are not using threads, forking, or IPC then the only difference between
+a C<filter> and a C<pre_filter> is that C<pre_filter> subs run first. When you
+are using threads, forking, or IPC, pre_filters happen to events before they
+are sent to their destination proc/thread, ordinary filters happen only in the
+destination hub/thread.
+
+You cannot add a regular filter to a hub if the hub was created in another
+process or thread. You can always add a pre_filter.
+
+=item $hub->unfilter($sub)
+
+=item $hub->pre_unfilter($sub)
+
+These can be used to remove filters and pre_filters. The C<$sub> argument is
+the reference returned by C<filter()> or C<pre_filter()>.
+
+=item $hub->follow_op(sub { ... })
+
+Use this to add behaviors that are called just before the hub is finalized. The
+only argument to your codeblock will be a L<Test2::Util::Trace> instance.
+
+ $hub->follow_up(sub {
+ my ($trace, $hub) = @_;
+
+ ... do whatever you need to ...
+
+ # Return is ignored
+ });
+
+follow_up subs are called only once, ether when done_testing is called, or in
+an END block.
+
+=item $sub = $hub->add_context_acquire(sub { ... });
+
+Add a callback that will be called every time someone tries to acquire a
+context. It gets a single argument, a reference of the hash of parameters
+being used the construct the context. This is your chance to change the
+parameters by directly altering the hash.
+
+ test2_add_callback_context_acquire(sub {
+ my $params = shift;
+ $params->{level}++;
+ });
+
+This is a very scary API function. Please do not use this unless you need to.
+This is here for L<Test::Builder> and backwards compatibility. This has you
+directly manipulate the hash instead of returning a new one for performance
+reasons.
+
+B<Note> Using this hook could have a huge performance impact.
+
+The coderef you provide is returned and can be used to remove the hook later.
+
+=item $hub->remove_context_acquire($sub);
+
+This can be used to remove a context acquire hook.
+
+=item $sub = $hub->add_context_init(sub { ... });
+
+This allows you to add callbacks that will trigger every time a new context is
+created for the hub. The only argument to the sub will be the
+L<Test2::API::Context> instance that was created.
+
+B<Note> Using this hook could have a huge performance impact.
+
+The coderef you provide is returned and can be used to remove the hook later.
+
+=item $hub->remove_context_init($sub);
+
+This can be used to remove a context init hook.
+
+=item $sub = $hub->add_context_release(sub { ... });
+
+This allows you to add callbacks that will trigger every time a context for
+this hub is released. The only argument to the sub will be the
+L<Test2::API::Context> instance that was released. These will run in reverse
+order.
+
+B<Note> Using this hook could have a huge performance impact.
+
+The coderef you provide is returned and can be used to remove the hook later.
+
+=item $hub->remove_context_release($sub);
+
+This can be used to remove a context release hook.
+
+=item $hub->cull()
+
+Cull any IPC events (and process them).
+
+=item $pid = $hub->pid()
+
+Get the process id under which the hub was created.
+
+=item $tid = $hub->tid()
+
+Get the thread id under which the hub was created.
+
+=item $hud = $hub->hid()
+
+Get the identifier string of the hub.
+
+=item $ipc = $hub->ipc()
+
+Get the IPC object used by the hub.
+
+=item $hub->set_no_ending($bool)
+
+=item $bool = $hub->no_ending
+
+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'.
+
+=item $bool = $hub->active
+
+=item $hub->set_active($bool)
+
+These are used to get/set the 'active' attribute. When true this attribute will
+force C<< hub->finalize() >> to take action even if there is no plan, and no
+tests have been run. This flag is useful for plugins that add follow-up
+behaviors that need to run even if no events are seen.
+
+=back
+
+=head2 STATE METHODS
+
+=over 4
+
+=item $hub->reset_state()
+
+Reset all state to the start. This sets the test count to 0, clears the plan,
+removes the failures, etc.
+
+=item $num = $hub->count
+
+Get the number of tests that have been run.
+
+=item $num = $hub->failed
+
+Get the number of failures (Not all failures come from a test fail, so this
+number can be larger than the count).
+
+=item $bool = $hub->ended
+
+True if the testing has ended. This MAY return the stack frame of the tool that
+ended the test, but that is not guaranteed.
+
+=item $bool = $hub->is_passing
+
+=item $hub->is_passing($bool)
+
+Check if the overall test run is a failure. Can also be used to set the
+pass/fail status.
+
+=item $hub->plan($plan)
+
+=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'.
+
+=item $bool = $hub->check_plan
+
+Check if the plan and counts match, but only if the tests have ended. If tests
+have not ended this will return undef, otherwise it will be a true/false.
+
+=back
+
+=head1 THIRD PARTY META-DATA
+
+This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
+way for you to attach meta-data to instances of this class. This is useful for
+tools, plugins, and other extensions.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm b/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm
new file mode 100755
index 00000000000..42be265f8d7
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor.pm
@@ -0,0 +1,80 @@
+package Test2::Hub::Interceptor;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Test2::Hub::Interceptor::Terminator();
+
+BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
+use Test2::Util::HashBase;
+
+sub inherit {
+ my $self = shift;
+ my ($from, %params) = @_;
+
+ if ($from->{+IPC} && !$self->{+IPC} && !exists($params{ipc})) {
+ my $ipc = $from->{+IPC};
+ $self->{+IPC} = $ipc;
+ $ipc->add_hub($self->{+HID});
+ }
+}
+
+sub terminate {
+ my $self = shift;
+ my ($code) = @_;
+
+ eval {
+ no warnings 'exiting';
+ last T2_SUBTEST_WRAPPER;
+ };
+ my $err = $@;
+
+ # Fallback
+ die bless(\$err, 'Test2::Hub::Interceptor::Terminator');
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Hub::Interceptor - Hub used by interceptor to grab results.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm b/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm
new file mode 100755
index 00000000000..f7201904689
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Hub/Interceptor/Terminator.pm
@@ -0,0 +1,51 @@
+package Test2::Hub::Interceptor::Terminator;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Hub::Interceptor::Terminator - Exception class used by
+Test2::Hub::Interceptor
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm b/Master/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm
new file mode 100755
index 00000000000..adb3d6f15ed
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Hub/Subtest.pm
@@ -0,0 +1,125 @@
+package Test2::Hub::Subtest;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
+use Test2::Util::HashBase qw/nested bailed_out exit_code manual_skip_all id/;
+use Test2::Util qw/get_tid/;
+
+my $ID = 1;
+sub init {
+ my $self = shift;
+ $self->SUPER::init(@_);
+ $self->{+ID} ||= join "-", $$, get_tid, $ID++;
+}
+
+sub is_subtest { 1 }
+
+sub process {
+ my $self = shift;
+ my ($e) = @_;
+ $e->set_nested($self->nested);
+ $e->set_in_subtest($self->{+ID});
+ $self->set_bailed_out($e) if $e->isa('Test2::Event::Bail');
+ $self->SUPER::process($e);
+}
+
+sub send {
+ my $self = shift;
+ my ($e) = @_;
+
+ my $out = $self->SUPER::send($e);
+
+ return $out if $self->{+MANUAL_SKIP_ALL};
+ return $out unless $e->isa('Test2::Event::Plan')
+ && $e->directive eq 'SKIP'
+ && ($e->trace->pid != $self->pid || $e->trace->tid != $self->tid);
+
+ no warnings 'exiting';
+ last T2_SUBTEST_WRAPPER;
+}
+
+sub terminate {
+ my $self = shift;
+ my ($code, $e) = @_;
+ $self->set_exit_code($code);
+
+ return if $self->{+MANUAL_SKIP_ALL};
+ return if $e->isa('Test2::Event::Plan')
+ && $e->directive eq 'SKIP'
+ && ($e->trace->pid != $$ || $e->trace->tid != get_tid);
+
+ no warnings 'exiting';
+ last T2_SUBTEST_WRAPPER;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Hub::Subtest - Hub used by subtests
+
+=head1 DESCRIPTION
+
+Subtests make use of this hub to route events.
+
+=head1 TOGGLES
+
+=over 4
+
+=item $bool = $hub->manual_skip_all
+
+=item $hub->set_manual_skip_all($bool)
+
+The default is false.
+
+Normally a skip-all plan event will cause a subtest to stop executing. This is
+accomplished via C<last LABEL> to a label inside the subtest code. Most of the
+time this is perfectly fine. There are times however where this flow control
+causes bad things to happen.
+
+This toggle lets you turn off the abort logic for the hub. When this is toggled
+to true B<you> are responsible for ensuring no additional events are generated.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/IPC.pm b/Master/tlpkg/tlperl/lib/Test2/IPC.pm
new file mode 100755
index 00000000000..92447919c11
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/IPC.pm
@@ -0,0 +1,140 @@
+package Test2::IPC;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Test2::API::Instance;
+use Test2::Util qw/get_tid/;
+use Test2::API qw{
+ test2_init_done
+ test2_ipc
+ test2_ipc_enable_polling
+ test2_pid
+ test2_stack
+ test2_tid
+ context
+};
+
+use Carp qw/confess/;
+
+our @EXPORT_OK = qw/cull/;
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
+
+sub import {
+ goto &Exporter::import unless test2_init_done();
+
+ confess "Cannot add IPC in a child process (" . test2_pid() . " vs $$)" if test2_pid() != $$;
+ confess "Cannot add IPC in a child thread (" . test2_tid() . " vs " . get_tid() . ")" if test2_tid() != get_tid();
+
+ Test2::API::_set_ipc(_make_ipc());
+ apply_ipc(test2_stack());
+
+ goto &Exporter::import;
+}
+
+sub _make_ipc {
+ # Find a driver
+ my ($driver) = Test2::API::test2_ipc_drivers();
+ unless ($driver) {
+ require Test2::IPC::Driver::Files;
+ $driver = 'Test2::IPC::Driver::Files';
+ }
+
+ return $driver->new();
+}
+
+sub apply_ipc {
+ my $stack = shift;
+
+ my ($root) = @$stack;
+
+ return unless $root;
+
+ confess "Cannot add IPC in a child process" if $root->pid != $$;
+ confess "Cannot add IPC in a child thread" if $root->tid != get_tid();
+
+ my $ipc = $root->ipc || test2_ipc() || _make_ipc();
+
+ # Add the IPC to all hubs
+ for my $hub (@$stack) {
+ my $has = $hub->ipc;
+ confess "IPC Mismatch!" if $has && $has != $ipc;
+ next if $has;
+ $hub->set_ipc($ipc);
+ $ipc->add_hub($hub->hid);
+ }
+
+ test2_ipc_enable_polling();
+
+ return $ipc;
+}
+
+sub cull {
+ my $ctx = context();
+ $ctx->hub->cull;
+ $ctx->release;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::IPC - Turn on IPC for threading or forking support.
+
+=head1 SYNOPSIS
+
+You should C<use Test2::IPC;> as early as possible in your test file. If you
+import this module after API initialization it will attempt to retrofit IPC
+onto the existing hubs.
+
+=head1 EXPORTS
+
+All exports are optional.
+
+=over 4
+
+=item cull()
+
+Cull allows you to collect results from other processes or threads on demand.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/IPC/Driver.pm b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver.pm
new file mode 100755
index 00000000000..cd34f7c0258
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver.pm
@@ -0,0 +1,292 @@
+package Test2::IPC::Driver;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Carp qw/confess longmess/;
+use Test2::Util::HashBase qw{no_fatal};
+
+use Test2::API qw/test2_ipc_add_driver/;
+
+my %ADDED;
+sub import {
+ my $class = shift;
+ return if $class eq __PACKAGE__;
+ return if $ADDED{$class}++;
+ test2_ipc_add_driver($class);
+}
+
+sub use_shm { 0 }
+
+for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) {
+ no strict 'refs';
+ *$meth = sub {
+ my $thing = shift;
+ confess "'$thing' did not define the required method '$meth'."
+ };
+}
+
+# Print the error and call exit. We are not using 'die' cause this is a
+# catastrophic error that should never be caught. If we get here it
+# means some serious shit has happened in a child process, the only way
+# to inform the parent may be to exit false.
+
+sub abort {
+ my $self = shift;
+ chomp(my ($msg) = @_);
+ print STDERR "IPC Fatal Error: $msg\n";
+ print STDOUT "not ok - IPC Fatal Error\n";
+
+ CORE::exit(255) unless $self->no_fatal;
+}
+
+sub abort_trace {
+ my $self = shift;
+ my ($msg) = @_;
+ $self->abort(longmess($msg));
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::IPC::Driver - Base class for Test2 IPC drivers.
+
+=head1 SYNOPSIS
+
+ package Test2::IPC::Driver::MyDriver;
+
+ use base 'Test2::IPC::Driver';
+
+ ...
+
+=head1 METHODS
+
+=over 4
+
+=item $self->abort($msg)
+
+If an IPC encounters a fatal error it should use this. This will print the
+message to STDERR with C<'IPC Fatal Error: '> prefixed to it, then it will
+forcefully exit 255. IPC errors may occur in threads or processes other than
+the main one, this method provides the best chance of the harness noticing the
+error.
+
+=item $self->abort_trace($msg)
+
+This is the same as C<< $ipc->abort($msg) >> except that it uses
+C<Carp::longmess> to add a stack trace to the message.
+
+=item $false = $self->use_shm
+
+The base class always returns false for this method. You may override it if you
+wish to use the SHM made available in L<Test2::API>/L<Test2::API::Instance>.
+
+=back
+
+=head1 LOADING DRIVERS
+
+Test2::IPC::Driver has an C<import()> method. All drivers inherit this import
+method. This import method registers the driver.
+
+In most cases you just need to load the desired IPC driver to make it work. You
+should load this driver as early as possible. A warning will be issued if you
+load it too late for it to be effective.
+
+ use Test2::IPC::Driver::MyDriver;
+ ...
+
+=head1 WRITING DRIVERS
+
+ package Test2::IPC::Driver::MyDriver;
+ use strict;
+ use warnings;
+
+ use base 'Test2::IPC::Driver';
+
+ sub is_viable {
+ return 0 if $^O eq 'win32'; # Will not work on windows.
+ return 1;
+ }
+
+ sub add_hub {
+ my $self = shift;
+ my ($hid) = @_;
+
+ ... # Make it possible to contact the hub
+ }
+
+ sub drop_hub {
+ my $self = shift;
+ my ($hid) = @_;
+
+ ... # Nothing should try to reach the hub anymore.
+ }
+
+ sub send {
+ my $self = shift;
+ my ($hid, $e, $global) = @_;
+
+ ... # Send the event to the proper hub.
+
+ # If you are using the SHM you should notify other procs/threads that
+ # there is a pending event.
+ Test2::API::test2_ipc_set_pending($uniq_val);
+ }
+
+ sub cull {
+ my $self = shift;
+ my ($hid) = @_;
+
+ my @events = ...; # Here is where you get the events for the hub
+
+ return @events;
+ }
+
+ sub waiting {
+ my $self = shift;
+
+ ... # Notify all listening procs and threads that the main
+ ... # process/thread is waiting for them to finish.
+ }
+
+ 1;
+
+=head2 METHODS SUBCLASSES MUST IMPLEMENT
+
+=over 4
+
+=item $ipc->is_viable
+
+This should return true if the driver works in the current environment. This
+should return false if it does not. This is a CLASS method.
+
+=item $ipc->add_hub($hid)
+
+This is used to alert the driver that a new hub is expecting events. The driver
+should keep track of the process and thread ids, the hub should only be dropped
+by the proc+thread that started it.
+
+ sub add_hub {
+ my $self = shift;
+ my ($hid) = @_;
+
+ ... # Make it possible to contact the hub
+ }
+
+=item $ipc->drop_hub($hid)
+
+This is used to alert the driver that a hub is no longer accepting events. The
+driver should keep track of the process and thread ids, the hub should only be
+dropped by the proc+thread that started it (This is the drivers responsibility
+to enforce).
+
+ sub drop_hub {
+ my $self = shift;
+ my ($hid) = @_;
+
+ ... # Nothing should try to reach the hub anymore.
+ }
+
+=item $ipc->send($hid, $event);
+
+=item $ipc->send($hid, $event, $global);
+
+Used to send events from the current process/thread to the specified hub in its
+process+thread.
+
+ sub send {
+ my $self = shift;
+ my ($hid, $e) = @_;
+
+ ... # Send the event to the proper hub.
+
+ # If you are using the SHM you should notify other procs/threads that
+ # there is a pending event.
+ Test2::API::test2_ipc_set_pending($uniq_val);
+ }
+
+If C<$global> is true then the driver should send the event to all hubs in all
+processes and threads.
+
+=item @events = $ipc->cull($hid)
+
+Used to collect events that have been sent to the specified hub.
+
+ sub cull {
+ my $self = shift;
+ my ($hid) = @_;
+
+ my @events = ...; # Here is where you get the events for the hub
+
+ return @events;
+ }
+
+=item $ipc->waiting()
+
+This is called in the parent process when it is complete and waiting for all
+child processes and threads to complete.
+
+ sub waiting {
+ my $self = shift;
+
+ ... # Notify all listening procs and threads that the main
+ ... # process/thread is waiting for them to finish.
+ }
+
+=back
+
+=head2 METHODS SUBCLASSES MAY IMPLEMENT OR OVERRIDE
+
+=over 4
+
+=item $bool = $ipc->use_shm()
+
+True if you want to make use of the L<Test2::API>/L<Test2::API::Instance> SHM.
+
+=item $bites = $ipc->shm_size()
+
+Use this to customize the size of the SHM space. There are no guarantees about
+what the size will be if you do not implement this.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm
new file mode 100755
index 00000000000..998fef56376
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm
@@ -0,0 +1,497 @@
+package Test2::IPC::Driver::Files;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
+
+use Test2::Util::HashBase qw{tempdir event_id tid pid globals};
+
+use Scalar::Util qw/blessed/;
+use File::Temp();
+use Storable();
+use File::Spec();
+use POSIX();
+
+use Test2::Util qw/try get_tid pkg_to_file IS_WIN32 ipc_separator/;
+use Test2::API qw/test2_ipc_set_pending/;
+
+BEGIN {
+ if (IS_WIN32) {
+ my $max_tries = 5;
+
+ *do_rename = sub {
+ my ($from, $to) = @_;
+
+ my $err;
+ for (1 .. $max_tries) {
+ return (1) if rename($from, $to);
+ $err = "$!";
+ last if $_ == $max_tries;
+ sleep 1;
+ }
+
+ return (0, $err);
+ };
+ *do_unlink = sub {
+ my ($file) = @_;
+
+ my $err;
+ for (1 .. $max_tries) {
+ return (1) if unlink($file);
+ $err = "$!";
+ last if $_ == $max_tries;
+ sleep 1;
+ }
+
+ return (0, "$!");
+ };
+ }
+ else {
+ *do_rename = sub {
+ my ($from, $to) = @_;
+ return (1) if rename($from, $to);
+ return (0, "$!");
+ };
+ *do_unlink = sub {
+ my ($file) = @_;
+ return (1) if unlink($file);
+ return (0, "$!");
+ };
+ }
+}
+
+sub use_shm { 1 }
+sub shm_size() { 64 }
+
+sub is_viable { 1 }
+
+sub init {
+ my $self = shift;
+
+ my $tmpdir = File::Temp::tempdir(
+ $ENV{T2_TEMPDIR_TEMPLATE} || "test2" . ipc_separator . $$ . ipc_separator . "XXXXXX",
+ CLEANUP => 0,
+ TMPDIR => 1,
+ );
+
+ $self->abort_trace("Could not get a temp dir") unless $tmpdir;
+
+ $self->{+TEMPDIR} = File::Spec->canonpath($tmpdir);
+
+ print STDERR "\nIPC Temp Dir: $tmpdir\n\n"
+ if $ENV{T2_KEEP_TEMPDIR};
+
+ $self->{+EVENT_ID} = 1;
+
+ $self->{+TID} = get_tid();
+ $self->{+PID} = $$;
+
+ $self->{+GLOBALS} = {};
+
+ return $self;
+}
+
+sub hub_file {
+ my $self = shift;
+ my ($hid) = @_;
+ my $tdir = $self->{+TEMPDIR};
+ return File::Spec->catfile($tdir, "HUB" . ipc_separator . $hid);
+}
+
+sub event_file {
+ my $self = shift;
+ my ($hid, $e) = @_;
+
+ my $tempdir = $self->{+TEMPDIR};
+ my $type = blessed($e) or $self->abort("'$e' is not a blessed object!");
+
+ $self->abort("'$e' is not an event object!")
+ unless $type->isa('Test2::Event');
+
+ my @type = split '::', $type;
+ my $name = join(ipc_separator, $hid, $$, get_tid(), $self->{+EVENT_ID}++, @type);
+
+ return File::Spec->catfile($tempdir, $name);
+}
+
+sub add_hub {
+ my $self = shift;
+ my ($hid) = @_;
+
+ my $hfile = $self->hub_file($hid);
+
+ $self->abort_trace("File for hub '$hid' already exists")
+ if -e $hfile;
+
+ open(my $fh, '>', $hfile) or $self->abort_trace("Could not create hub file '$hid': $!");
+ print $fh "$$\n" . get_tid() . "\n";
+ close($fh);
+}
+
+sub drop_hub {
+ my $self = shift;
+ my ($hid) = @_;
+
+ my $tdir = $self->{+TEMPDIR};
+ my $hfile = $self->hub_file($hid);
+
+ $self->abort_trace("File for hub '$hid' does not exist")
+ unless -e $hfile;
+
+ open(my $fh, '<', $hfile) or $self->abort_trace("Could not open hub file '$hid': $!");
+ my ($pid, $tid) = <$fh>;
+ close($fh);
+
+ $self->abort_trace("A hub file can only be closed by the process that started it\nExpected $pid, got $$")
+ unless $pid == $$;
+
+ $self->abort_trace("A hub file can only be closed by the thread that started it\nExpected $tid, got " . get_tid())
+ unless get_tid() == $tid;
+
+ if ($ENV{T2_KEEP_TEMPDIR}) {
+ my ($ok, $err) = do_rename($hfile, File::Spec->canonpath("$hfile.complete"));
+ $self->abort_trace("Could not rename file '$hfile' -> '$hfile.complete': $err") unless $ok
+ }
+ else {
+ my ($ok, $err) = do_unlink($hfile);
+ $self->abort_trace("Could not remove file for hub '$hid': $err") unless $ok
+ }
+
+ opendir(my $dh, $tdir) or $self->abort_trace("Could not open temp dir!");
+ 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!");
+ }
+ closedir($dh);
+}
+
+sub send {
+ my $self = shift;
+ my ($hid, $e, $global) = @_;
+
+ my $tempdir = $self->{+TEMPDIR};
+ my $hfile = $self->hub_file($hid);
+ my $dest = $global ? 'GLOBAL' : $hid;
+
+ $self->abort(<<" EOT") unless $global || -f $hfile;
+hub '$hid' is not available, failed to send event!
+
+There was an attempt to send an event to a hub in a parent process or thread,
+but that hub appears to be gone. This can happen if you fork, or start a new
+thread from inside subtest, and the parent finishes the subtest before the
+child returns.
+
+This can also happen if the parent process is done testing before the child
+finishes. Test2 normally waits automatically in the root process, but will not
+do so if Test::Builder is loaded for legacy reasons.
+ EOT
+
+ my $file = $self->event_file($dest, $e);
+ my $ready = File::Spec->canonpath("$file.ready");
+
+ if ($global) {
+ my $name = $ready;
+ $name =~ s{^.*(GLOBAL)}{GLOBAL};
+ $self->{+GLOBALS}->{$hid}->{$name}++;
+ }
+
+ my ($old, $blocked);
+ unless(IS_WIN32) {
+ my $to_block = POSIX::SigSet->new(
+ POSIX::SIGINT(),
+ POSIX::SIGALRM(),
+ POSIX::SIGHUP(),
+ POSIX::SIGTERM(),
+ POSIX::SIGUSR1(),
+ POSIX::SIGUSR2(),
+ );
+ $old = POSIX::SigSet->new;
+ $blocked = POSIX::sigprocmask(POSIX::SIG_BLOCK(), $to_block, $old);
+ # Silently go on if we failed to log signals, not much we can do.
+ }
+
+ # Write and rename the file.
+ my ($ok, $err) = try {
+ Storable::store($e, $file);
+ my ($ok, $err) = do_rename("$file", $ready);
+ unless ($ok) {
+ POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked;
+ $self->abort("Could not rename file '$file' -> '$ready': $err");
+ };
+ test2_ipc_set_pending(substr($file, -(shm_size)));
+ };
+
+ # If our block was successful we want to restore the old mask.
+ POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked;
+
+ if (!$ok) {
+ my $src_file = __FILE__;
+ $err =~ s{ at \Q$src_file\E.*$}{};
+ chomp($err);
+ my $tid = get_tid();
+ my $trace = $e->trace->debug;
+ my $type = blessed($e);
+
+ $self->abort(<<" EOT");
+
+*******************************************************************************
+There was an error writing an event:
+Destination: $dest
+Origin PID: $$
+Origin TID: $tid
+Event Type: $type
+Event Trace: $trace
+File Name: $file
+Ready Name: $ready
+Error: $err
+*******************************************************************************
+
+ EOT
+ }
+
+ return 1;
+}
+
+sub cull {
+ my $self = shift;
+ my ($hid) = @_;
+
+ my $tempdir = $self->{+TEMPDIR};
+
+ opendir(my $dh, $tempdir) or $self->abort("could not open IPC temp dir ($tempdir)!");
+
+ my @out;
+ for my $info (sort cmp_events map { $self->should_read_event($hid, $_) } readdir($dh)) {
+ my $full = $info->{full_path};
+ my $obj = $self->read_event_file($full);
+ push @out => $obj;
+
+ # Do not remove global events
+ next if $info->{global};
+
+ if ($ENV{T2_KEEP_TEMPDIR}) {
+ my $complete = File::Spec->canonpath("$full.complete");
+ my ($ok, $err) = do_rename($full, $complete);
+ $self->abort("Could not rename IPC file '$full', '$complete': $err") unless $ok;
+ }
+ else {
+ my ($ok, $err) = do_unlink("$full");
+ $self->abort("Could not unlink IPC file '$full': $err") unless $ok;
+ }
+ }
+
+ closedir($dh);
+ return @out;
+}
+
+sub parse_event_filename {
+ my $self = shift;
+ my ($file) = @_;
+
+ # The || is to force 0 in false
+ my $complete = substr($file, -9, 9) eq '.complete' || 0 and substr($file, -9, 9, "");
+ my $ready = substr($file, -6, 6) eq '.ready' || 0 and substr($file, -6, 6, "");
+
+ my @parts = split ipc_separator, $file;
+ my ($global, $hid) = $parts[0] eq 'GLOBAL' ? (1, shift @parts) : (0, join ipc_separator, splice(@parts, 0, 3));
+ my ($pid, $tid, $eid) = splice(@parts, 0, 3);
+ my $type = join '::' => @parts;
+
+ return {
+ ready => $ready,
+ complete => $complete,
+ global => $global,
+ type => $type,
+ hid => $hid,
+ pid => $pid,
+ tid => $tid,
+ eid => $eid,
+ };
+}
+
+sub should_read_event {
+ my $self = shift;
+ my ($hid, $file) = @_;
+
+ return if substr($file, 0, 1) eq '.';
+
+ my $parsed = $self->parse_event_filename($file);
+
+ return if $parsed->{complete};
+ return unless $parsed->{ready};
+ return unless $parsed->{global} || $parsed->{hid} eq $hid;
+
+ return if $parsed->{global} && $self->{+GLOBALS}->{$hid}->{$file}++;
+
+ # Untaint the path.
+ my $full = File::Spec->catfile($self->{+TEMPDIR}, $file);
+ ($full) = ($full =~ m/^(.*)$/gs) if ${^TAINT};
+
+ $parsed->{full_path} = $full;
+
+ return $parsed;
+}
+
+sub cmp_events {
+ # Globals first
+ return -1 if $a->{global} && !$b->{global};
+ return 1 if $b->{global} && !$a->{global};
+
+ return $a->{pid} <=> $b->{pid}
+ || $a->{tid} <=> $b->{tid}
+ || $a->{eid} <=> $b->{eid};
+}
+
+sub read_event_file {
+ my $self = shift;
+ my ($file) = @_;
+
+ my $obj = Storable::retrieve($file);
+ $self->abort("Got an unblessed object: '$obj'")
+ unless blessed($obj);
+
+ unless ($obj->isa('Test2::Event')) {
+ my $pkg = blessed($obj);
+ my $mod_file = pkg_to_file($pkg);
+ my ($ok, $err) = try { require $mod_file };
+
+ $self->abort("Event has unknown type ($pkg), tried to load '$mod_file' but failed: $err")
+ unless $ok;
+
+ $self->abort("'$obj' is not a 'Test2::Event' object")
+ unless $obj->isa('Test2::Event');
+ }
+
+ return $obj;
+}
+
+sub waiting {
+ my $self = shift;
+ require Test2::Event::Waiting;
+ $self->send(
+ GLOBAL => Test2::Event::Waiting->new(
+ trace => Test2::Util::Trace->new(frame => [caller()]),
+ ),
+ 'GLOBAL'
+ );
+ return;
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ return unless defined $self->pid;
+ return unless defined $self->tid;
+
+ return unless $$ == $self->pid;
+ return unless get_tid() == $self->tid;
+
+ my $tempdir = $self->{+TEMPDIR};
+
+ opendir(my $dh, $tempdir) or $self->abort("Could not open temp dir! ($tempdir)");
+ while(my $file = readdir($dh)) {
+ next if $file =~ m/^\.+$/;
+ next if $file =~ m/\.complete$/;
+ my $full = File::Spec->catfile($tempdir, $file);
+
+ my $sep = ipc_separator;
+ if ($file =~ m/^(GLOBAL|HUB$sep)/) {
+ $full =~ m/^(.*)$/;
+ $full = $1; # Untaint it
+ next if $ENV{T2_KEEP_TEMPDIR};
+ my ($ok, $err) = do_unlink($full);
+ $self->abort("Could not unlink IPC file '$full': $err") unless $ok;
+ next;
+ }
+
+ $self->abort("Leftover files in the directory ($full)!\n");
+ }
+ closedir($dh);
+
+ if ($ENV{T2_KEEP_TEMPDIR}) {
+ print STDERR "# Not removing temp dir: $tempdir\n";
+ return;
+ }
+
+ rmdir($tempdir) or warn "Could not remove IPC temp dir ($tempdir)";
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::IPC::Driver::Files - Temp dir + Files concurrency model.
+
+=head1 DESCRIPTION
+
+This is the default, and fallback concurrency model for L<Test2>. This
+sends events between processes and threads using serialized files in a
+temporary directory. This is not particularly fast, but it works everywhere.
+
+=head1 SYNOPSIS
+
+ use Test2::IPC::Driver::Files;
+
+ # IPC is now enabled
+
+=head1 ENVIRONMENT VARIABLES
+
+=over 4
+
+=item T2_KEEP_TEMPDIR=0
+
+When true, the tempdir used by the IPC driver will not be deleted when the test
+is done.
+
+=item T2_TEMPDIR_TEMPLATE='test2-XXXXXX'
+
+This can be used to set the template for the IPC temp dir. The template should
+follow template specifications from L<File::Temp>.
+
+=back
+
+=head1 SEE ALSO
+
+See L<Test2::IPC::Driver> for methods.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm b/Master/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm
new file mode 100755
index 00000000000..857a923c6a2
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Tools/Tiny.pm
@@ -0,0 +1,425 @@
+package Test2::Tools::Tiny;
+use strict;
+use warnings;
+
+use Scalar::Util qw/blessed/;
+
+use Test2::Util qw/try/;
+use Test2::API qw/context run_subtest test2_stack/;
+
+use Test2::Hub::Interceptor();
+use Test2::Hub::Interceptor::Terminator();
+
+our $VERSION = '1.302073';
+
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
+our @EXPORT = qw{
+ ok is isnt like unlike is_deeply diag note skip_all todo plan done_testing
+ warnings exception tests capture
+};
+
+sub ok($;$@) {
+ my ($bool, $name, @diag) = @_;
+ my $ctx = context();
+ $ctx->ok($bool, $name, \@diag);
+ $ctx->release;
+ return $bool ? 1 : 0;
+}
+
+sub is($$;$@) {
+ my ($got, $want, $name, @diag) = @_;
+ my $ctx = context();
+
+ my $bool;
+ if (defined($got) && defined($want)) {
+ $bool = "$got" eq "$want";
+ }
+ elsif (defined($got) xor defined($want)) {
+ $bool = 0;
+ }
+ else { # Both are undef
+ $bool = 1;
+ }
+
+ unless ($bool) {
+ $got = '*NOT DEFINED*' unless defined $got;
+ $want = '*NOT DEFINED*' unless defined $want;
+ unshift @diag => (
+ "GOT: $got",
+ "EXPECTED: $want",
+ );
+ }
+
+ $ctx->ok($bool, $name, \@diag);
+ $ctx->release;
+ return $bool;
+}
+
+sub isnt($$;$@) {
+ my ($got, $want, $name, @diag) = @_;
+ my $ctx = context();
+
+ my $bool;
+ if (defined($got) && defined($want)) {
+ $bool = "$got" ne "$want";
+ }
+ elsif (defined($got) xor defined($want)) {
+ $bool = 1;
+ }
+ else { # Both are undef
+ $bool = 0;
+ }
+
+ unshift @diag => "Strings are the same (they should not be)"
+ unless $bool;
+
+ $ctx->ok($bool, $name, \@diag);
+ $ctx->release;
+ return $bool;
+}
+
+sub like($$;$@) {
+ my ($thing, $pattern, $name, @diag) = @_;
+ my $ctx = context();
+
+ my $bool;
+ if (defined($thing)) {
+ $bool = "$thing" =~ $pattern;
+ unshift @diag => (
+ "Value: $thing",
+ "Does not match: $pattern"
+ ) unless $bool;
+ }
+ else {
+ $bool = 0;
+ unshift @diag => "Got an undefined value.";
+ }
+
+ $ctx->ok($bool, $name, \@diag);
+ $ctx->release;
+ return $bool;
+}
+
+sub unlike($$;$@) {
+ my ($thing, $pattern, $name, @diag) = @_;
+ my $ctx = context();
+
+ my $bool;
+ if (defined($thing)) {
+ $bool = "$thing" !~ $pattern;
+ unshift @diag => (
+ "Unexpected pattern match (it should not match)",
+ "Value: $thing",
+ "Matches: $pattern"
+ ) unless $bool;
+ }
+ else {
+ $bool = 0;
+ unshift @diag => "Got an undefined value.";
+ }
+
+ $ctx->ok($bool, $name, \@diag);
+ $ctx->release;
+ return $bool;
+}
+
+sub is_deeply($$;$@) {
+ my ($got, $want, $name, @diag) = @_;
+ my $ctx = context();
+
+ no warnings 'once';
+ require Data::Dumper;
+ local $Data::Dumper::Sortkeys = 1;
+ local $Data::Dumper::Deparse = 1;
+ local $Data::Dumper::Freezer = 'XXX';
+ local *UNIVERSAL::XXX = sub {
+ my ($thing) = @_;
+ if (ref($thing)) {
+ $thing = {%$thing} if "$thing" =~ m/=HASH/;
+ $thing = [@$thing] if "$thing" =~ m/=ARRAY/;
+ $thing = \"$$thing" if "$thing" =~ m/=SCALAR/;
+ }
+ $_[0] = $thing;
+ };
+
+ my $g = Data::Dumper::Dumper($got);
+ my $w = Data::Dumper::Dumper($want);
+
+ my $bool = $g eq $w;
+
+ my $diff;
+
+ $ctx->ok($bool, $name, [$diff ? $diff : ($g, $w), @diag]);
+ $ctx->release;
+ return $bool;
+}
+
+sub diag {
+ my $ctx = context();
+ $ctx->diag(join '', @_);
+ $ctx->release;
+}
+
+sub note {
+ my $ctx = context();
+ $ctx->note(join '', @_);
+ $ctx->release;
+}
+
+sub skip_all {
+ my ($reason) = @_;
+ my $ctx = context();
+ $ctx->plan(0, SKIP => $reason);
+ $ctx->release if $ctx;
+}
+
+sub todo {
+ my ($reason, $sub) = @_;
+ my $ctx = context();
+
+ # This code is mostly copied from Test2::Todo in the Test2-Suite
+ # distribution.
+ my $hub = test2_stack->top;
+ my $filter = $hub->pre_filter(
+ sub {
+ my ($active_hub, $event) = @_;
+
+ # Turn a diag into a note
+ return Test2::Event::Note->new(%$event) if ref($event) eq 'Test2::Event::Diag';
+
+ # Set todo on ok's
+ if ($hub == $active_hub && $event->isa('Test2::Event::Ok')) {
+ $event->set_todo($reason);
+ $event->set_effective_pass(1);
+ }
+
+ return $event;
+ },
+ inherit => 1,
+ todo => $reason,
+ );
+ $sub->();
+ $hub->pre_unfilter($filter);
+
+ $ctx->release if $ctx;
+}
+
+sub plan {
+ my ($max) = @_;
+ my $ctx = context();
+ $ctx->plan($max);
+ $ctx->release;
+}
+
+sub done_testing {
+ my $ctx = context();
+ $ctx->done_testing;
+ $ctx->release;
+}
+
+sub warnings(&) {
+ my $code = shift;
+ my @warnings;
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ $code->();
+ return \@warnings;
+}
+
+sub exception(&) {
+ my $code = shift;
+ local ($@, $!, $SIG{__DIE__});
+ my $ok = eval { $code->(); 1 };
+ my $error = $@ || 'SQUASHED ERROR';
+ return $ok ? undef : $error;
+}
+
+sub tests {
+ my ($name, $code) = @_;
+ my $ctx = context();
+
+ before_each() if __PACKAGE__->can('before_each');
+
+ my $bool = run_subtest($name, $code, 1);
+
+ $ctx->release;
+
+ return $bool;
+}
+
+sub capture(&) {
+ my $code = shift;
+
+ my ($err, $out) = ("", "");
+
+ my $handles = test2_stack->top->format->handles;
+ my ($ok, $e);
+ {
+ my ($out_fh, $err_fh);
+
+ ($ok, $e) = try {
+ open($out_fh, '>', \$out) or die "Failed to open a temporary STDOUT: $!";
+ open($err_fh, '>', \$err) or die "Failed to open a temporary STDERR: $!";
+
+ test2_stack->top->format->set_handles([$out_fh, $err_fh, $out_fh]);
+
+ $code->();
+ };
+ }
+ test2_stack->top->format->set_handles($handles);
+
+ die $e unless $ok;
+
+ $err =~ s/ $/_/mg;
+ $out =~ s/ $/_/mg;
+
+ return {
+ STDOUT => $out,
+ STDERR => $err,
+ };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Tools::Tiny - Tiny set of tools for unfortunate souls who cannot use
+L<Test2::Suite>.
+
+=head1 DESCRIPTION
+
+You should really look at L<Test2::Suite>. This package is some very basic
+essential tools implemented using L<Test2>. This exists only so that L<Test2>
+and other tools required by L<Test2::Suite> can be tested. This is the package
+L<Test2> uses to test itself.
+
+=head1 USE Test2::Suite INSTEAD
+
+Use L<Test2::Suite> if at all possible.
+
+=head1 EXPORTS
+
+=over 4
+
+=item ok($bool, $name)
+
+=item ok($bool, $name, @diag)
+
+Run a simple assertion.
+
+=item is($got, $want, $name)
+
+=item is($got, $want, $name, @diag)
+
+Assert that 2 strings are the same.
+
+=item isnt($got, $do_not_want, $name)
+
+=item isnt($got, $do_not_want, $name, @diag)
+
+Assert that 2 strings are not the same.
+
+=item like($got, $regex, $name)
+
+=item like($got, $regex, $name, @diag)
+
+Check that the input string matches the regex.
+
+=item unlike($got, $regex, $name)
+
+=item unlike($got, $regex, $name, @diag)
+
+Check that the input string does not match the regex.
+
+=item is_deeply($got, $want, $name)
+
+=item is_deeply($got, $want, $name, @diag)
+
+Check 2 data structures. Please note that this is a I<DUMB> implementation that
+compares the output of L<Data::Dumper> against both structures.
+
+=item diag($msg)
+
+Issue a diagnostics message to STDERR.
+
+=item note($msg)
+
+Issue a diagnostics message to STDOUT.
+
+=item skip_all($reason)
+
+Skip all tests.
+
+=item todo $reason => sub { ... }
+
+Run a block in TODO mode.
+
+=item plan($count)
+
+Set the plan.
+
+=item done_testing()
+
+Set the plan to the current test count.
+
+=item $warnings = warnings { ... }
+
+Capture an arrayref of warnings from the block.
+
+=item $exception = exception { ... }
+
+Capture an exception.
+
+=item tests $name => sub { ... }
+
+Run a subtest.
+
+=item $output = capture { ... }
+
+Capture STDOUT and STDERR output.
+
+Result looks like this:
+
+ {
+ STDOUT => "...",
+ STDERR => "...",
+ }
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Transition.pod b/Master/tlpkg/tlperl/lib/Test2/Transition.pod
new file mode 100755
index 00000000000..95f9d77e9b1
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Transition.pod
@@ -0,0 +1,512 @@
+=pod
+
+=head1 NAME
+
+Test2::Transition - Transition notes when upgrading to Test2
+
+=head1 DESCRIPTION
+
+This is where gotchas and breakages related to the Test2 upgrade are
+documented. The upgrade causes Test::Builder to defer to Test2 under the hood.
+This transition is mostly transparent, but there are a few cases that can trip
+you up.
+
+=head1 THINGS THAT BREAK
+
+This is the list of scenarios that break with the new internals.
+
+=head2 Test::Builder1.5/2 conditionals
+
+=head3 The Problem
+
+a few years back there were two attempts to upgrade/replace Test::Builder.
+Confusingly these were called Test::Builder2 and Test::Builder1.5, in that
+order. Many people put conditionals in their code to check the Test::Builder
+version number and adapt their code accordingly.
+
+The Test::Builder2/1.5 projects both died out. Now the conditional code people
+added has become a mine field. A vast majority of modules broken by Test2 fall
+into this category.
+
+=head3 The Fix
+
+The fix is to remove all Test::Builder1.5/2 related code. Either use the
+legacy Test::Builder API, or use Test2 directly.
+
+=head2 Replacing the Test::Builder singleton
+
+=head3 The Problem
+
+Some test modules would replace the Test::Builder singleton instance with their
+own instance or subclass. This was usually done to intercept or modify results
+as they happened.
+
+The Test::Builder singleton is now a simple compatibility wrapper around
+Test2. The Test::Builder singleton is no longer the central place for
+results. Many results bypass the Test::Builder singleton completely, which
+breaks and behavior intended when replacing the singleton.
+
+=head3 The Fix
+
+If you simply want to intercept all results instead of letting them go to TAP,
+you should look at the L<Test2::API> docs and read about pushing a new hub onto
+the hub stack. Replacing the hub temporarily is now the correct way to
+intercept results.
+
+If your goal is purely monitoring of events use the C<< Test2::Hub->listen() >>
+method exported by Test::More to watch events as they are fired. If you wish to
+modify results before they go to TAP look at the C<< Test2::Hub->filter() >>
+method.
+
+=head2 Directly Accessing Hash Elements
+
+=head3 The Problem
+
+Some modules look directly at hash keys on the Test::Builder singleton. The
+problem here is that the Test::Builder singleton no longer holds anything
+important.
+
+=head3 The Fix
+
+The fix is to use the API specified in L<Test2::API> to look at or modify state
+as needed.
+
+=head2 Subtest indentation
+
+=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
+to outdent the subtest note instead of having it inline with the subtest:
+
+ # subtest foo
+ ok 1 - blah
+ 1..1
+ ok 1 - subtest foo
+
+The old style indented the note:
+
+ # subtest foo
+ ok 1 - blah
+ 1..1
+ ok 1 - subtest foo
+
+This breaks tests that do string comparison of TAP output.
+
+=head3 The Fix
+
+ my $indent = $INC{'Test2/API.pm'} ? '' : ' ';
+
+ is(
+ $subtest_output,
+ "${indent}# subtest foo",
+ "Got subtest note"
+ );
+
+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
+should be expected.
+
+=head1 DISTRIBUTIONS THAT BREAK OR NEED TO BE UPGRADED
+
+This is a list of cpan modules that have been known to have been broken by the
+upgrade at one point.
+
+=head2 WORKS BUT TESTS WILL FAIL
+
+These modules still function correctly, but their test suites will not pass. If
+you already have these modules installed then you can continue to use them. If
+you are trying to install them after upgrading Test::Builder you will need to
+force installation, or bypass the broken tests.
+
+=over 4
+
+=item Test::DBIx::Class::Schema
+
+This module has a test that appears to work around a Test::Builder bug. The bug
+appears to have been fixed by Test2, which means the workaround causes a
+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.
+
+Known broken in version 0.07. Apparently works fine in 0.06 though. Patch has
+been submitted to fix the issue.
+
+=back
+
+=head2 UPGRADE SUGGESTED
+
+These are modules that did not break, but had broken test suites that have
+since been fixed.
+
+=over 4
+
+=item Test::Exception
+
+Old versions work fine, but have a minor test name behavior that breaks with
+Test2. Old versions will no longer install because of this. The latest version
+on CPAN will install just fine. Upgrading is not required, but is recommended.
+
+Fixed in version: 0.43
+
+=item Data::Peek
+
+Some tests depended on C<$!> and C<$?> being modified in subtle ways. A patch
+was applied to correct things that changed.
+
+The module itself works fine, there is no need to upgrade.
+
+Fixed in version: 0.45
+
+=item circular::require
+
+Some tests were fragile and required base.pm to be loaded at a late stage.
+Test2 was loading base.pm too early. The tests were updated to fix this.
+
+The module itself never broke, you do not need to upgrade.
+
+Fixed in version: 0.12
+
+=item Test::Module::Used
+
+A test worked around a now-fixed planning bug. There is no need to upgrade if
+you have an old version installed. New versions install fine if you want them.
+
+Fixed in version: 0.2.5
+
+=item Test::Moose::More
+
+Some tests were fragile, but have been fixed. The actual breakage was from the
+subtest comment indentation change.
+
+No need to upgrade, old versions work fine. Only new versions will install.
+
+Fixed in version: 0.025
+
+=item Test::FITesque
+
+This was broken by a bugfix to how planning is done. The test was updated after
+the bugfix.
+
+Fixed in version: 0.04
+
+=item autouse
+
+A test broke because it depended on Scalar::Util not being loaded. Test2 loads
+Scalar::Util. The test was updated to load Test2 after checking Scalar::Util's
+load status.
+
+There is no need to upgrade if you already have it installed.
+
+Fixed in version: 1.11
+
+=back
+
+=head2 NEED TO UPGRADE
+
+=over 4
+
+=item Test::SharedFork
+
+Old versions need to directly access Test::Builder singleton hash elements. The
+latest version on CPAN will still do this on old Test::Builder, but will defer
+to L<Test2::IPC> on Test2.
+
+Fixed in version: 0.35
+
+=item Test::Builder::Clutch
+
+This works by doing overriding methods on the singleton, and directly accessing
+hash values on the singleton. A new version has been released that uses the
+Test2 API to accomplish the same result in a saner way.
+
+Fixed in version: 0.07
+
+=item Test::Dist::VersionSync
+
+This had Test::Builder2 conditionals. This was fixed by removing the
+conditionals.
+
+Fixed in version: 1.1.4
+
+=item Test::Modern
+
+This relied on C<< Test::Builder->_try() >> which was a private method,
+documented as something nobody should use. This was fixed by using a different
+tool.
+
+Fixed in version: 0.012
+
+=item Test::UseAllModules
+
+Version 0.14 relied on C<< Test::Builder->history >> which was available in
+Test::Builder 1.5. Versions 0.12 and 0.13 relied on other Test::Builder
+internals.
+
+Fixed in version: 0.15
+
+=back
+
+=head2 STILL BROKEN
+
+=over 4
+
+=item Test::Aggregate
+
+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.
+
+Still broken as of version: 0.373
+
+=item Test::Wrapper
+
+This module directly uses hash keys in the L<Test::Builder> singleton. This
+module is also obsolete thanks to the benefits of L<Test2>. Use C<intercept()>
+from L<Test2::API> to achieve a similar result.
+
+Still broken as of version: 0.3.0
+
+=item Test::ParallelSubtest
+
+This module overrides C<Test::Builder::subtest()> and
+C<Test::Builder::done_testing()>. It also directly accesses hash elements of
+the singleton. It has not yet been fixed.
+
+Alternatives: L<Test2::AsyncSubtest> and L<Test2::Workflow> (not stable).
+
+Still broken as of version: 0.05
+
+=item Test::Pretty
+
+See https://github.com/tokuhirom/Test-Pretty/issues/25
+
+The author admits the module is crazy, and he is awaiting a stable release of
+something new (Test2) to completely rewrite it in a sane way.
+
+Still broken as of version: 0.32
+
+=item Test::More::Prefix
+
+The current version, 0.005 is broken. A patch has been applied in git, and
+released in 0.006, but a version issue with 0.006 prevents its installation.
+
+Still broken as of version: 0.005
+Potentially fixed in version: 0.006 (not installable)
+
+=item Net::BitTorrent
+
+The tests for this module directly access L<Test::Builder> hash keys. Most, if
+not all of these hash keys have public API methods that could be used instead
+to avoid the problem.
+
+Still broken in version: 0.052
+
+=item Test::Group
+
+It monkeypatches Test::Builder, and calls it "black magic" in the code.
+
+Still broken as of version: 0.20
+
+=item Test::Flatten
+
+This modifies the Test::Builder internals in many ways. A better was to
+accomplish the goal of this module is to write your own subtest function.
+
+Still broken as of version: 0.11
+
+=item Log::Dispatch::Config::TestLog
+
+Modifies Test::Builder internals.
+
+Still broken as of version: 0.02
+
+=item Test::Able
+
+Modifies Test::Builder internals.
+
+Still broken as of version: 0.11
+
+=back
+
+=head1 MAKE ASSERTIONS -> SEND EVENTS
+
+=head2 LEGACY
+
+ use Test::Builder;
+
+ # A majority of tools out there do this:
+ # my $TB = Test::Builder->new;
+ # This works, but has always been wrong, forcing Test::Builder to implement
+ # subtests as a horrific hack. It also causes problems for tools that try
+ # to replace the singleton (also discouraged).
+
+ sub my_ok($;$) {
+ my ($bool, $name) = @_;
+ my $TB = Test::Builder->new;
+ $TB->ok($bool, $name);
+ }
+
+ sub my_diag($) {
+ my ($msg) = @_;
+ my $TB = Test::Builder->new;
+ $TB->diag($msg);
+ }
+
+=head2 TEST2
+
+ use Test2::API qw/context/;
+
+ sub my_ok($;$) {
+ my ($bool, $name) = @_;
+ my $ctx = context();
+ $ctx->ok($bool, $name);
+ $ctx->release;
+ }
+
+ sub my_diag($) {
+ my ($msg) = @_;
+ my $ctx = context();
+ $ctx->diag($msg);
+ $ctx->release;
+ }
+
+The context object has API compatible implementations of the following methods:
+
+=over 4
+
+=item ok($bool, $name)
+
+=item diag(@messages)
+
+=item note(@messages)
+
+=item subtest($name, $code)
+
+=back
+
+If you are looking for helpers with C<is>, C<like>, and others, see
+L<Test2::Suite>.
+
+=head1 WRAP EXISTING TOOLS
+
+=head2 LEGACY
+
+ use Test::More;
+
+ sub exclusive_ok {
+ my ($bool1, $bool2, $name) = @_;
+
+ # Ensure errors are reported 1 level higher
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ $ok = $bool1 || $bool2;
+ $ok &&= !($bool1 && $bool2);
+ ok($ok, $name);
+
+ return $bool;
+ }
+
+Every single tool in the chain from this, to C<ok>, to anything C<ok> calls
+needs to increment the C<$Level> variable. When an error occurs Test::Builder
+will do a trace to the stack frame determined by C<$Level>, and report that
+file+line as the one where the error occurred. If you or any other tool you use
+forgets to set C<$Level> then errors will be reported to the wrong place.
+
+=head2 TEST2
+
+ use Test::More;
+
+ sub exclusive_ok {
+ my ($bool1, $bool2, $name) = @_;
+
+ # Grab and store the context, even if you do not need to use it
+ # directly.
+ my $ctx = context();
+
+ $ok = $bool1 || $bool2;
+ $ok &&= !($bool1 && $bool2);
+ ok($ok, $name);
+
+ $ctx->release;
+ return $bool;
+ }
+
+Instead of using C<$Level> to perform a backtrace, Test2 uses a context
+object. In this sample you create a context object and store it. This locks the
+context (errors report 1 level up from here) for all wrapped tools to find. You
+do not need to use the context object, but you do need to store it in a
+variable. Once the sub ends the C<$ctx> variable is destroyed which lets future
+tools find their own.
+
+=head1 USING UTF8
+
+=head2 LEGACY
+
+ # Set the mode BEFORE anything loads Test::Builder
+ use open ':std', ':encoding(utf8)';
+ use Test::More;
+
+Or
+
+ # Modify the filehandles
+ my $builder = Test::More->builder;
+ binmode $builder->output, ":encoding(utf8)";
+ binmode $builder->failure_output, ":encoding(utf8)";
+ binmode $builder->todo_output, ":encoding(utf8)";
+
+=head2 TEST2
+
+ use Test2::API qw/test2_stack/;
+
+ test2_stack->top->format->encoding('utf8');
+
+Though a much better way is to use the L<Test2::Plugin::UTF8> plugin, which is
+part of L<Test2::Suite>.
+
+=head1 AUTHORS, CONTRIBUTORS AND REVIEWERS
+
+The following people have all contributed to this document in some way, even if
+only for review.
+
+=over 4
+
+=item Chad Granum (EXODIST) E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Test2 can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 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://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/Test2/Util.pm b/Master/tlpkg/tlperl/lib/Test2/Util.pm
new file mode 100755
index 00000000000..53379d41dde
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Util.pm
@@ -0,0 +1,258 @@
+package Test2::Util;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Config qw/%Config/;
+
+our @EXPORT_OK = qw{
+ try
+
+ pkg_to_file
+
+ get_tid USE_THREADS
+ CAN_THREAD
+ CAN_REALLY_FORK
+ CAN_FORK
+
+ IS_WIN32
+
+ ipc_separator
+};
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
+
+BEGIN {
+ *IS_WIN32 = ($^O eq 'MSWin32') ? sub() { 1 } : sub() { 0 };
+}
+
+sub _can_thread {
+ return 0 unless $] >= 5.008001;
+ return 0 unless $Config{'useithreads'};
+
+ # Threads are broken on perl 5.10.0 built with gcc 4.8+
+ if ($] == 5.010000 && $Config{'ccname'} eq 'gcc' && $Config{'gccversion'}) {
+ my @parts = split /\./, $Config{'gccversion'};
+ return 0 if $parts[0] > 4 || ($parts[0] == 4 && $parts[1] >= 8);
+ }
+
+ # Change to a version check if this ever changes
+ return 0 if $INC{'Devel/Cover.pm'};
+ return 1;
+}
+
+sub _can_fork {
+ return 1 if $Config{d_fork};
+ return 0 unless IS_WIN32 || $^O eq 'NetWare';
+ return 0 unless $Config{useithreads};
+ return 0 unless $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/;
+
+ return _can_thread();
+}
+
+BEGIN {
+ no warnings 'once';
+ *CAN_THREAD = _can_thread() ? sub() { 1 } : sub() { 0 };
+}
+my $can_fork;
+sub CAN_FORK () {
+ return $can_fork
+ if defined $can_fork;
+ $can_fork = !!_can_fork();
+ no warnings 'redefine';
+ *CAN_FORK = $can_fork ? sub() { 1 } : sub() { 0 };
+ $can_fork;
+}
+my $can_really_fork;
+sub CAN_REALLY_FORK () {
+ return $can_really_fork
+ if defined $can_really_fork;
+ $can_really_fork = !!$Config{d_fork};
+ no warnings 'redefine';
+ *CAN_REALLY_FORK = $can_really_fork ? sub() { 1 } : sub() { 0 };
+ $can_really_fork;
+}
+
+sub _manual_try(&;@) {
+ my $code = shift;
+ my $args = \@_;
+ my $err;
+
+ my $die = delete $SIG{__DIE__};
+
+ eval { $code->(@$args); 1 } or $err = $@ || "Error was squashed!\n";
+
+ $die ? $SIG{__DIE__} = $die : delete $SIG{__DIE__};
+
+ return (!defined($err), $err);
+}
+
+sub _local_try(&;@) {
+ my $code = shift;
+ my $args = \@_;
+ my $err;
+
+ no warnings;
+ local $SIG{__DIE__};
+ eval { $code->(@$args); 1 } or $err = $@ || "Error was squashed!\n";
+
+ return (!defined($err), $err);
+}
+
+# Older versions of perl have a nasty bug on win32 when localizing a variable
+# before forking or starting a new thread. So for those systems we use the
+# non-local form. When possible though we use the faster 'local' form.
+BEGIN {
+ if (IS_WIN32 && $] < 5.020002) {
+ *try = \&_manual_try;
+ }
+ else {
+ *try = \&_local_try;
+ }
+}
+
+BEGIN {
+ if (CAN_THREAD) {
+ if ($INC{'threads.pm'}) {
+ # Threads are already loaded, so we do not need to check if they
+ # are loaded each time
+ *USE_THREADS = sub() { 1 };
+ *get_tid = sub() { threads->tid() };
+ }
+ else {
+ # :-( Need to check each time to see if they have been loaded.
+ *USE_THREADS = sub() { $INC{'threads.pm'} ? 1 : 0 };
+ *get_tid = sub() { $INC{'threads.pm'} ? threads->tid() : 0 };
+ }
+ }
+ else {
+ # No threads, not now, not ever!
+ *USE_THREADS = sub() { 0 };
+ *get_tid = sub() { 0 };
+ }
+}
+
+sub pkg_to_file {
+ my $pkg = shift;
+ my $file = $pkg;
+ $file =~ s{(::|')}{/}g;
+ $file .= '.pm';
+ return $file;
+}
+
+sub ipc_separator() { "~" }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Util - Tools used by Test2 and friends.
+
+=head1 DESCRIPTION
+
+Collection of tools used by L<Test2> and friends.
+
+=head1 EXPORTS
+
+All exports are optional. You must specify subs to import.
+
+=over 4
+
+=item ($success, $error) = try { ... }
+
+Eval the codeblock, return success or failure, and the error message. This code
+protects $@ and $!, they will be restored by the end of the run. This code also
+temporarily blocks $SIG{DIE} handlers.
+
+=item protect { ... }
+
+Similar to try, except that it does not catch exceptions. The idea here is to
+protect $@ and $! from changes. $@ and $! will be restored to whatever they
+were before the run so long as it is successful. If the run fails $! will still
+be restored, but $@ will contain the exception being thrown.
+
+=item CAN_FORK
+
+True if this system is capable of true or pseudo-fork.
+
+=item CAN_REALLY_FORK
+
+True if the system can really fork. This will be false for systems where fork
+is emulated.
+
+=item CAN_THREAD
+
+True if this system is capable of using threads.
+
+=item USE_THREADS
+
+Returns true if threads are enabled, false if they are not.
+
+=item get_tid
+
+This will return the id of the current thread when threads are enabled,
+otherwise it returns 0.
+
+=item my $file = pkg_to_file($package)
+
+Convert a package name to a filename.
+
+=back
+
+=head1 NOTES && CAVEATS
+
+=over 4
+
+=item 5.10.0
+
+Perl 5.10.0 has a bug when compiled with newer gcc versions. This bug causes a
+segfault whenever a new thread is launched. Test2 will attempt to detect
+this, and note that the system is not capable of forking when it is detected.
+
+=item Devel::Cover
+
+Devel::Cover does not support threads. CAN_THREAD will return false if
+Devel::Cover is loaded before the check is first run.
+
+=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>
+
+=item Kent Fredric E<lt>kentnl@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 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/Master/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm b/Master/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm
new file mode 100755
index 00000000000..f9c611e0f25
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Util/ExternalMeta.pm
@@ -0,0 +1,182 @@
+package Test2::Util::ExternalMeta;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Carp qw/croak/;
+
+sub META_KEY() { '_meta' }
+
+our @EXPORT = qw/meta set_meta get_meta delete_meta/;
+BEGIN { require Exporter; our @ISA = qw(Exporter) }
+
+sub set_meta {
+ my $self = shift;
+ my ($key, $value) = @_;
+
+ validate_key($key);
+
+ $self->{+META_KEY} ||= {};
+ $self->{+META_KEY}->{$key} = $value;
+}
+
+sub get_meta {
+ my $self = shift;
+ my ($key) = @_;
+
+ validate_key($key);
+
+ my $meta = $self->{+META_KEY} or return undef;
+ return $meta->{$key};
+}
+
+sub delete_meta {
+ my $self = shift;
+ my ($key) = @_;
+
+ validate_key($key);
+
+ my $meta = $self->{+META_KEY} or return undef;
+ delete $meta->{$key};
+}
+
+sub meta {
+ my $self = shift;
+ my ($key, $default) = @_;
+
+ validate_key($key);
+
+ my $meta = $self->{+META_KEY};
+ return undef unless $meta || defined($default);
+
+ unless($meta) {
+ $meta = {};
+ $self->{+META_KEY} = $meta;
+ }
+
+ $meta->{$key} = $default
+ if defined($default) && !defined($meta->{$key});
+
+ return $meta->{$key};
+}
+
+sub validate_key {
+ my $key = shift;
+
+ return if $key && !ref($key);
+
+ my $render_key = defined($key) ? "'$key'" : 'undef';
+ croak "Invalid META key: $render_key, keys must be true, and may not be references";
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Util::ExternalMeta - Allow third party tools to safely attach meta-data
+to your instances.
+
+=head1 DESCRIPTION
+
+This package lets you define a clear, and consistent way to allow third party
+tools to attach meta-data to your instances. If your object consumes this
+package, and imports its methods, then third party meta-data has a safe place
+to live.
+
+=head1 SYNOPSIS
+
+ package My::Object;
+ use strict;
+ use warnings;
+
+ use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
+
+ ...
+
+Now to use it:
+
+ my $inst = My::Object->new;
+
+ $inst->set_meta(foo => 'bar');
+ my $val = $inst->get_meta('foo');
+
+=head1 WHERE IS THE DATA STORED?
+
+This package assumes your instances are blessed hashrefs, it will not work if
+that is not true. It will store all meta-data in the C<_meta> key on your
+objects hash. If your object makes use of the C<_meta> key in its underlying
+hash, then there is a conflict and you cannot use this package.
+
+=head1 EXPORTS
+
+=over 4
+
+=item $val = $obj->meta($key)
+
+=item $val = $obj->meta($key, $default)
+
+This will get the value for a specified meta C<$key>. Normally this will return
+C<undef> when there is no value for the C<$key>, however you can specify a
+C<$default> value to set when no value is already set.
+
+=item $val = $obj->get_meta($key)
+
+This will get the value for a specified meta C<$key>. This does not have the
+C<$default> overhead that C<meta()> does.
+
+=item $val = $obj->delete_meta($key)
+
+This will remove the value of a specified meta C<$key>. The old C<$val> will be
+returned.
+
+=item $obj->set_meta($key, $val)
+
+Set the value of a specified meta C<$key>.
+
+=back
+
+=head1 META-KEY RESTRICTIONS
+
+Meta keys must be defined, and must be true when used as a boolean. Keys may
+not be references. You are free to stringify a reference C<"$ref"> for use as a
+key, but this package will not stringify it for you.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm b/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm
new file mode 100755
index 00000000000..76041efe5ee
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm
@@ -0,0 +1,289 @@
+package Test2::Util::HashBase;
+use strict;
+use warnings;
+
+#################################################################
+# #
+# This is a generated file! Do not modify this file directly! #
+# Use hashbase_inc.pl script to regenerate this file. #
+# The script is part of the Object::HashBase distribution. #
+# #
+#################################################################
+
+{
+ no warnings 'once';
+ $Test2::Util::HashBase::VERSION = '0.002';
+ *Test2::Util::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS;
+}
+
+
+require Carp;
+{
+ no warnings 'once';
+ $Carp::Internal{+__PACKAGE__} = 1;
+}
+
+BEGIN {
+ # these are not strictly equivalent, but for out use we don't care
+ # about order
+ *_isa = ($] >= 5.010 && require mro) ? \&mro::get_linear_isa : sub {
+ no strict 'refs';
+ my @packages = ($_[0]);
+ my %seen;
+ for my $package (@packages) {
+ push @packages, grep !$seen{$_}++, @{"$package\::ISA"};
+ }
+ return \@packages;
+ }
+}
+
+my %STRIP = (
+ '^' => 1,
+ '-' => 1,
+);
+
+sub import {
+ my $class = shift;
+ my $into = caller;
+
+ my $isa = _isa($into);
+ my $attr_subs = $Test2::Util::HashBase::ATTR_SUBS{$into} ||= {};
+ my %subs = (
+ ($into->can('new') ? () : (new => \&_new)),
+ (map %{$Test2::Util::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 .. $#$isa]),
+ (
+ map {
+ my $p = substr($_, 0, 1);
+ my $x = $_;
+ substr($x, 0, 1) = '' if $STRIP{$p};
+ 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] }),
+ } @_
+ ),
+ );
+
+ no strict 'refs';
+ *{"$into\::$_"} = $subs{$_} for keys %subs;
+}
+
+sub _new {
+ my ($class, %params) = @_;
+ my $self = bless \%params, $class;
+ $self->init if $self->can('init');
+ $self;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Util::HashBase - Build hash based classes.
+
+=head1 SYNOPSIS
+
+A class:
+
+ package My::Class;
+ use strict;
+ use warnings;
+
+ # Generate 3 accessors
+ use Test2::Util::HashBase qw/foo -bar ^baz/;
+
+ # Chance to initialize defaults
+ sub init {
+ my $self = shift; # No other args
+ $self->{+FOO} ||= "foo";
+ $self->{+BAR} ||= "bar";
+ $self->{+BAZ} ||= "baz";
+ }
+
+ sub print {
+ print join ", " => map { $self->{$_} } FOO, BAR, BAZ;
+ }
+
+Subclass it
+
+ package My::Subclass;
+ use strict;
+ use warnings;
+
+ # Note, you should subclass before loading HashBase.
+ use base 'My::Class';
+ use Test2::Util::HashBase qw/bat/;
+
+ sub init {
+ my $self = shift;
+
+ # We get the constants from the base class for free.
+ $self->{+FOO} ||= 'SubFoo';
+ $self->{+BAT} ||= 'bat';
+
+ $self->SUPER::init();
+ }
+
+use it:
+
+ package main;
+ use strict;
+ use warnings;
+ use My::Class;
+
+ my $one = My::Class->new(foo => 'MyFoo', bar => 'MyBar');
+
+ # Accessors!
+ my $foo = $one->foo; # 'MyFoo'
+ my $bar = $one->bar; # 'MyBar'
+ my $baz = $one->baz; # Defaulted to: 'baz'
+
+ # Setters!
+ $one->set_foo('A Foo');
+
+ #'-bar' means read-only, so the setter will throw an exception (but is defined).
+ $one->set_bar('A bar');
+
+ # '^baz' means deprecated setter, this will warn about the setter being
+ # deprecated.
+ $one->set_baz('A Baz');
+
+ $one->{+FOO} = 'xxx';
+
+=head1 DESCRIPTION
+
+This package is used to generate classes based on hashrefs. Using this class
+will give you a C<new()> method, as well as generating accessors you request.
+Generated accessors will be getters, C<set_ACCESSOR> setters will also be
+generated for you. You also get constants for each accessor (all caps) which
+return the key into the hash for that accessor. Single inheritance is also
+supported.
+
+=head1 THIS IS A BUNDLED COPY OF HASHBASE
+
+This is a bundled copy of L<Object::HashBase>. This file was generated using
+the
+C</home/exodist/perl5/perlbrew/perls/main/bin/hashbase_inc.pl>
+script.
+
+=head1 METHODS
+
+=head2 PROVIDED BY HASH BASE
+
+=over 4
+
+=item $it = $class->new(@VALUES)
+
+Create a new instance using key/value pairs.
+
+HashBase will not export C<new()> if there is already a C<new()> method in your
+packages inheritance chain.
+
+B<If you do not want this method you can define your own> you just have to
+declare it before loading L<Test2::Util::HashBase>.
+
+ package My::Package;
+
+ # predeclare new() so that HashBase does not give us one.
+ sub new;
+
+ use Test2::Util::HashBase qw/foo bar baz/;
+
+ # Now we define our own new method.
+ sub new { ... }
+
+This makes it so that HashBase sees that you have your own C<new()> method.
+Alternatively you can define the method before loading HashBase instead of just
+declaring it, but that scatters your use statements.
+
+=back
+
+=head2 HOOKS
+
+=over 4
+
+=item $self->init()
+
+This gives you the chance to set some default values to your fields. The only
+argument is C<$self> with its indexes already set from the constructor.
+
+=back
+
+=head1 ACCESSORS
+
+To generate accessors you list them when using the module:
+
+ use Test2::Util::HashBase qw/foo/;
+
+This will generate the following subs in your namespace:
+
+=over 4
+
+=item foo()
+
+Getter, used to get the value of the C<foo> field.
+
+=item set_foo()
+
+Setter, used to set the value of the C<foo> field.
+
+=item FOO()
+
+Constant, returns the field C<foo>'s key into the class hashref. Subclasses will
+also get this function as a constant, not simply a method, that means it is
+copied into the subclass namespace.
+
+The main reason for using these constants is to help avoid spelling mistakes
+and similar typos. It will not help you if you forget to prefix the '+' though.
+
+=back
+
+=head1 SUBCLASSING
+
+You can subclass an existing HashBase class.
+
+ use base 'Another::HashBase::Class';
+ use Test2::Util::HashBase qw/foo bar baz/;
+
+The base class is added to C<@ISA> for you, and all constants from base classes
+are added to subclasses automatically.
+
+=head1 SOURCE
+
+The source code repository for HashBase can be found at
+F<http://github.com/Test-More/HashBase/>.
+
+=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 2016 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/Master/tlpkg/tlperl/lib/Test2/Util/Trace.pm b/Master/tlpkg/tlperl/lib/Test2/Util/Trace.pm
new file mode 100755
index 00000000000..0f10bcb6ad3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Util/Trace.pm
@@ -0,0 +1,186 @@
+package Test2::Util::Trace;
+use strict;
+use warnings;
+
+our $VERSION = '1.302073';
+
+
+use Test2::Util qw/get_tid pkg_to_file/;
+
+use Carp qw/confess/;
+
+use Test2::Util::HashBase qw{frame detail pid tid};
+
+sub init {
+ confess "The 'frame' attribute is required"
+ unless $_[0]->{+FRAME};
+
+ $_[0]->{+PID} = $$ unless defined $_[0]->{+PID};
+ $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
+}
+
+sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
+
+sub debug {
+ my $self = shift;
+ return $self->{+DETAIL} if $self->{+DETAIL};
+ my ($pkg, $file, $line) = $self->call;
+ return "at $file line $line";
+}
+
+sub alert {
+ my $self = shift;
+ my ($msg) = @_;
+ warn $msg . ' ' . $self->debug . ".\n";
+}
+
+sub throw {
+ my $self = shift;
+ my ($msg) = @_;
+ die $msg . ' ' . $self->debug . ".\n";
+}
+
+sub call { @{$_[0]->{+FRAME}} }
+
+sub package { $_[0]->{+FRAME}->[0] }
+sub file { $_[0]->{+FRAME}->[1] }
+sub line { $_[0]->{+FRAME}->[2] }
+sub subname { $_[0]->{+FRAME}->[3] }
+
+sub from_json {
+ my $class = shift;
+ my %p = @_;
+
+ my $trace_pkg = delete $p{__PACKAGE__};
+ require(pkg_to_file($trace_pkg));
+
+ return $trace_pkg->new(%p);
+}
+
+sub TO_JSON {
+ my $self = shift;
+ return {%$self, __PACKAGE__ => ref $self};
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Util::Trace - Debug information for events
+
+=head1 DESCRIPTION
+
+The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to
+have access to information about where they were created. This object
+represents that information.
+
+=head1 SYNOPSIS
+
+ use Test2::Util::Trace;
+
+ my $trace = Test2::Util::Trace->new(
+ frame => [$package, $file, $line, $subname],
+ );
+
+=head1 METHODS
+
+=over 4
+
+=item $trace->set_detail($msg)
+
+=item $msg = $trace->detail
+
+Used to get/set a custom trace message that will be used INSTEAD of
+C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
+
+=item $str = $trace->debug
+
+Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set
+then its value will be returned instead.
+
+=item $trace->alert($MESSAGE)
+
+This issues a warning at the frame (filename and line number where
+errors should be reported).
+
+=item $trace->throw($MESSAGE)
+
+This throws an exception at the frame (filename and line number where
+errors should be reported).
+
+=item $frame = $trace->frame()
+
+Get the call frame arrayref.
+
+=item ($package, $file, $line, $subname) = $trace->call()
+
+Get the caller details for the debug-info. This is where errors should be
+reported.
+
+=item $pkg = $trace->package
+
+Get the debug-info package.
+
+=item $file = $trace->file
+
+Get the debug-info filename.
+
+=item $line = $trace->line
+
+Get the debug-info line number.
+
+=item $subname = $trace->subname
+
+Get the debug-info subroutine name.
+
+=item $hashref = $t->TO_JSON
+
+This returns a hashref suitable for passing to the C<<
+Test2::Util::Trace->from_json >> constructor. It is intended for use with the
+L<JSON> family of modules, which will look for a C<TO_JSON> method when
+C<convert_blessed> is true.
+
+=item $t = Test2::Util::Trace->from_json(%$hashref)
+
+Given the hash of data returned by C<< $t->TO_JSON >>, this method returns a
+new trace object of the appropriate subclass.
+
+=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 2016 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