Upgrade Test-Simple from version 1.302113 to 1.302120
authorSteve Hay <steve.m.hay@googlemail.com>
Thu, 30 Nov 2017 08:34:52 +0000 (08:34 +0000)
committerSteve Hay <steve.m.hay@googlemail.com>
Thu, 30 Nov 2017 08:34:52 +0000 (08:34 +0000)
71 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/Test-Simple/lib/Test/Builder.pm
cpan/Test-Simple/lib/Test/Builder/Formatter.pm
cpan/Test-Simple/lib/Test/Builder/Module.pm
cpan/Test-Simple/lib/Test/Builder/Tester.pm
cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm
cpan/Test-Simple/lib/Test/More.pm
cpan/Test-Simple/lib/Test/Simple.pm
cpan/Test-Simple/lib/Test/Tester.pm
cpan/Test-Simple/lib/Test/Tester/Capture.pm
cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm
cpan/Test-Simple/lib/Test/Tester/Delegate.pm
cpan/Test-Simple/lib/Test/use/ok.pm
cpan/Test-Simple/lib/Test2.pm
cpan/Test-Simple/lib/Test2/API.pm
cpan/Test-Simple/lib/Test2/API/Breakage.pm
cpan/Test-Simple/lib/Test2/API/Context.pm
cpan/Test-Simple/lib/Test2/API/Instance.pm
cpan/Test-Simple/lib/Test2/API/Stack.pm
cpan/Test-Simple/lib/Test2/Event.pm
cpan/Test-Simple/lib/Test2/Event/Bail.pm
cpan/Test-Simple/lib/Test2/Event/Diag.pm
cpan/Test-Simple/lib/Test2/Event/Encoding.pm
cpan/Test-Simple/lib/Test2/Event/Exception.pm
cpan/Test-Simple/lib/Test2/Event/Fail.pm
cpan/Test-Simple/lib/Test2/Event/Generic.pm
cpan/Test-Simple/lib/Test2/Event/Note.pm
cpan/Test-Simple/lib/Test2/Event/Ok.pm
cpan/Test-Simple/lib/Test2/Event/Pass.pm
cpan/Test-Simple/lib/Test2/Event/Plan.pm
cpan/Test-Simple/lib/Test2/Event/Skip.pm
cpan/Test-Simple/lib/Test2/Event/Subtest.pm
cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm
cpan/Test-Simple/lib/Test2/Event/Waiting.pm
cpan/Test-Simple/lib/Test2/EventFacet.pm
cpan/Test-Simple/lib/Test2/EventFacet/About.pm
cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm
cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm
cpan/Test-Simple/lib/Test2/EventFacet/Control.pm
cpan/Test-Simple/lib/Test2/EventFacet/Error.pm
cpan/Test-Simple/lib/Test2/EventFacet/Info.pm
cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm
cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm
cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm
cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm
cpan/Test-Simple/lib/Test2/Formatter.pm
cpan/Test-Simple/lib/Test2/Formatter/TAP.pm
cpan/Test-Simple/lib/Test2/Hub.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm
cpan/Test-Simple/lib/Test2/Hub/Subtest.pm
cpan/Test-Simple/lib/Test2/IPC.pm
cpan/Test-Simple/lib/Test2/IPC/Driver.pm
cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm
cpan/Test-Simple/lib/Test2/Tools/Tiny.pm
cpan/Test-Simple/lib/Test2/Util.pm
cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm
cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm
cpan/Test-Simple/lib/Test2/Util/HashBase.pm
cpan/Test-Simple/lib/Test2/Util/Trace.pm
cpan/Test-Simple/lib/ok.pm
cpan/Test-Simple/t/Legacy/subtest/callback.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/behavior/Subtest_callback.t [new file with mode: 0644]
cpan/Test-Simple/t/Test2/modules/API.t
cpan/Test-Simple/t/Test2/modules/API/Instance.t
cpan/Test-Simple/t/Test2/modules/IPC.t
cpan/Test-Simple/t/Test2/modules/IPC/Driver.t
cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t
cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t

index 093cb7e..27ffee5 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2409,6 +2409,7 @@ cpan/Test-Simple/t/Legacy/strays.t
 cpan/Test-Simple/t/Legacy/subtest/args.t
 cpan/Test-Simple/t/Legacy/subtest/bail_out.t
 cpan/Test-Simple/t/Legacy/subtest/basic.t
+cpan/Test-Simple/t/Legacy/subtest/callback.t
 cpan/Test-Simple/t/Legacy/subtest/die.t
 cpan/Test-Simple/t/Legacy/subtest/do.t
 cpan/Test-Simple/t/Legacy/subtest/events.t
@@ -2504,6 +2505,7 @@ cpan/Test-Simple/t/Test2/behavior/run_subtest_inherit.t
 cpan/Test-Simple/t/Test2/behavior/special_names.t
 cpan/Test-Simple/t/Test2/behavior/subtest_bailout.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_buffer_formatter.t
+cpan/Test-Simple/t/Test2/behavior/Subtest_callback.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_events.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_plan.t
 cpan/Test-Simple/t/Test2/behavior/Subtest_todo.t
index 1586ea7..639db91 100755 (executable)
@@ -1071,7 +1071,7 @@ use File::Glob qw(:case);
     },
 
     'Test::Simple' => {
-        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302113.tar.gz',
+        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302120.tar.gz',
         'FILES'        => q[cpan/Test-Simple],
         'EXCLUDED'     => [
             qr{^examples/},
index dc2ddc6..8db992f 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN {
     if( $] < 5.008 ) {
@@ -319,6 +319,10 @@ sub subtest {
 
     $name ||= "Child of " . $self->name;
 
+
+    $_->($name,$code,@args)
+        for Test2::API::test2_list_pre_subtest_callbacks();
+
     $ctx->note("Subtest: $name");
 
     my $child = $self->child($name);
index a828d21..caaa78d 100644 (file)
@@ -2,7 +2,7 @@ package Test::Builder::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) }
 
index 8b8da61..8cfd451 100644 (file)
@@ -7,7 +7,7 @@ use Test::Builder;
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 =head1 NAME
index 9d885af..6c304ba 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test::Builder;
 use Symbol;
index 8b7cde1..6dd6c67 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester::Color;
 
 use strict;
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 require Test::Builder::Tester;
 
index b4c6d2e..fd4e569 100644 (file)
@@ -2,7 +2,7 @@ package Test::Builder::TodoDiag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) }
 
index 25237e8..27b7d14 100644 (file)
@@ -17,7 +17,7 @@ sub _carp {
     return warn @_, " at $file line $line\n";
 }
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index 20c49ac..7697928 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 
 use strict;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index 81c3aed..f19ca74 100644 (file)
@@ -18,7 +18,7 @@ require Exporter;
 
 use vars qw( @ISA @EXPORT );
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 @EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
 @ISA = qw( Exporter );
index a403861..8f196f5 100644 (file)
@@ -2,7 +2,7 @@ use strict;
 
 package Test::Tester::Capture;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Test::Builder;
index 54a7064..4b2ea9d 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 
 package Test::Tester::CaptureRunner;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Test::Tester::Capture;
index 88f3493..3275fc7 100644 (file)
@@ -3,7 +3,7 @@ use warnings;
 
 package Test::Tester::Delegate;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Scalar::Util();
 
index 33ece84..bbd2d07 100644 (file)
@@ -1,7 +1,7 @@
 package Test::use::ok;
 use 5.005;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 __END__
index dc604e5..e7d5fbd 100644 (file)
@@ -2,7 +2,7 @@ package Test2;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 1;
index ea9199a..20d0d6e 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
     $ENV{TEST2_ACTIVE} = 1;
 }
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 my $INST;
@@ -93,6 +93,9 @@ our @EXPORT_OK = qw{
     test2_tid
     test2_stack
     test2_no_wait
+    test2_ipc_wait_enable
+    test2_ipc_wait_disable
+    test2_ipc_wait_enabled
 
     test2_add_callback_context_aquire
     test2_add_callback_context_acquire
@@ -100,14 +103,17 @@ our @EXPORT_OK = qw{
     test2_add_callback_context_release
     test2_add_callback_exit
     test2_add_callback_post_load
+    test2_add_callback_pre_subtest
     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_list_pre_subtest_callbacks
 
     test2_ipc
+    test2_has_ipc
     test2_ipc_drivers
     test2_ipc_add_driver
     test2_ipc_polling
@@ -158,9 +164,13 @@ sub test2_start_preload { $ENV{T2_IN_PRELOAD} = 1; $INST->start_preload }
 sub test2_stop_preload  { $ENV{T2_IN_PRELOAD} = 0; $INST->stop_preload }
 sub test2_in_preload    { $INST->preload }
 
-sub test2_pid     { $INST->pid }
-sub test2_tid     { $INST->tid }
-sub test2_stack   { $INST->stack }
+sub test2_pid              { $INST->pid }
+sub test2_tid              { $INST->tid }
+sub test2_stack            { $INST->stack }
+sub test2_ipc_wait_enable  { $INST->set_no_wait(0) }
+sub test2_ipc_wait_disable { $INST->set_no_wait(1) }
+sub test2_ipc_wait_enabled { !$INST->no_wait }
+
 sub test2_no_wait {
     $INST->set_no_wait(@_) if @_;
     $INST->no_wait;
@@ -172,14 +182,17 @@ 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_add_callback_pre_subtest       { $INST->add_pre_subtest_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_list_pre_subtest_callbacks     { @{$INST->pre_subtest_callbacks} }
 
 sub test2_ipc                 { $INST->ipc }
+sub test2_has_ipc             { $INST->has_ipc }
 sub test2_ipc_add_driver      { $INST->add_ipc_driver(@_) }
 sub test2_ipc_drivers         { @{$INST->ipc_drivers} }
 sub test2_ipc_polling         { $INST->ipc_polling }
@@ -510,6 +523,9 @@ sub _intercept {
 sub run_subtest {
     my ($name, $code, $params, @args) = @_;
 
+    $_->($name,$code,@args)
+        for Test2::API::test2_list_pre_subtest_callbacks();
+
     $params = {buffered => $params} unless ref $params;
     my $inherit_trace = delete $params->{inherit_trace};
 
@@ -1206,10 +1222,27 @@ Check if Test2 believes it is the END phase.
 This will return the global L<Test2::API::Stack> instance. If this has not
 yet been initialized it will be initialized now.
 
+=item test2_ipc_wait_enable()
+
+=item test2_ipc_wait_disable()
+
+=item $bool = test2_ipc_wait_enabled()
+
+These can be used to turn IPC waiting on and off, or check the current value of
+the flag.
+
+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.
+
 =item $bool = test2_no_wait()
 
 =item test2_no_wait($bool)
 
+B<DISCOURAGED>: This is a confusing interface, it is better to use
+C<test2_ipc_wait_enable()>, C<test2_ipc_wait_disable()> and
+C<test2_ipc_wait_enabled()>.
+
 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
@@ -1294,6 +1327,12 @@ callback will receive the newly created context as its only argument.
 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 test2_add_callback_pre_subtest(sub { ... })
+
+Add a callback that will be called every time a subtest is going to be
+run. The callback will receive the subtest name, coderef, and any
+arguments.
+
 =item @list = test2_list_context_acquire_callbacks()
 
 Return all the context acquire callback references.
@@ -1314,6 +1353,10 @@ Returns all the exit callback references.
 
 Returns all the post load callback references.
 
+=item @list = test2_list_pre_subtest_callbacks()
+
+Returns all the pre-subtest callback references.
+
 =back
 
 =head2 IPC AND CONCURRENCY
@@ -1322,6 +1365,10 @@ These let you access, or specify, the IPC system internals.
 
 =over 4
 
+=item $bool = test2_has_ipc()
+
+Check if IPC is enabled.
+
 =item $ipc = test2_ipc()
 
 This will return the global L<Test2::IPC::Driver> instance. If this has not yet
index 75120bc..13e87bc 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Breakage;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Test2::Util qw/pkg_to_file/;
index e3cf0bc..241af69 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Context;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Carp qw/confess croak/;
index f0fc711..92f442b 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Instance;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
@@ -36,6 +36,7 @@ use Test2::Util::HashBase qw{
     context_acquire_callbacks
     context_init_callbacks
     context_release_callbacks
+    pre_subtest_callbacks
 };
 
 sub DEFAULT_IPC_TIMEOUT() { 30 }
@@ -59,6 +60,8 @@ BEGIN {
     }
 }
 
+sub has_ipc { !!$_[0]->{+IPC} }
+
 sub import {
     my $class = shift;
     return unless @_;
@@ -135,6 +138,7 @@ sub reset {
     $self->{+CONTEXT_ACQUIRE_CALLBACKS} = [];
     $self->{+CONTEXT_INIT_CALLBACKS}    = [];
     $self->{+CONTEXT_RELEASE_CALLBACKS} = [];
+    $self->{+PRE_SUBTEST_CALLBACKS}     = [];
 
     $self->{+STACK} = Test2::API::Stack->new;
 }
@@ -274,6 +278,18 @@ sub add_post_load_callback {
     $code->() if $self->{+LOADED};
 }
 
+sub add_pre_subtest_callback {
+    my $self =  shift;
+    my ($code) = @_;
+
+    my $rtype = reftype($code) || "";
+
+    confess "Pre-subtest callbacks must be coderefs"
+        unless $code && $rtype eq 'CODE';
+
+    push @{$self->{+PRE_SUBTEST_CALLBACKS}} => $code;
+}
+
 sub load {
     my $self = shift;
     unless ($self->{+LOADED}) {
@@ -441,8 +457,10 @@ sub _ipc_wait {
                 last if $pid == -1;
                 next unless $err;
                 $fail++;
-                $err = $err >> 8;
-                warn "Process $pid did not exit cleanly (status: $err)\n";
+
+                my $sig = $err & 127;
+                my $exit = $err >> 8;
+                warn "Process $pid did not exit cleanly (wstat: $err, exit: $exit, sig: $sig)\n";
             }
 
             alarm 0;
@@ -676,6 +694,10 @@ Get all context init callbacks.
 
 Get all context release callbacks.
 
+=item $arrayref = $obj->pre_subtest_callbacks
+
+Get all pre-subtest callbacks.
+
 =item $obj->add_context_init_callback(sub { ... })
 
 Add a context init callback. Subs are called every time a context is created. Subs
@@ -687,6 +709,12 @@ Add a context release callback. Subs are called every time a context is released
 get the released context as their only argument. These callbacks should not
 call release on the context.
 
+=item $obj->add_pre_subtest_callback(sub { ... })
+
+Add a pre-subtest callback. Subs are called every time a subtest is
+going to be run. Subs get the subtest name, coderef, and any
+arguments.
+
 =item $obj->set_exit()
 
 This is intended to be called in an C<END { ... }> block. This will look at
index e0fc191..1eea110 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Stack;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Test2::Hub();
index a85690c..fc30caf 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test2::Util::HashBase qw/trace -amnesty/;
 use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
index e7577a0..0cc9c7d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Bail;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 2c2d686..a64e1bb 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Diag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 9ad4eda..67222ae 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Encoding;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Carp qw/croak/;
 
index 3bcb7a8..bb031e3 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Exception;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 98cad31..e73f061 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Fail;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test2::EventFacet::Info;
 
index f3ffe33..fcaf6dd 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use Carp qw/croak/;
 use Scalar::Util qw/reftype/;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
 use Test2::Util::HashBase;
index 76f3c06..640e250 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Note;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 924136f..5fc2586 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Ok;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 744eff7..0c8e15d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Pass;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test2::EventFacet::Info;
 
index 8e4d646..b4393de 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Plan;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 4c28c31..ee01d7e 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Skip;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
index 8678a9d..4465261 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
 use Test2::Util::HashBase qw{subevents buffered subtest_id};
index 7a81df3..3fabbae 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::TAP::Version;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Carp qw/croak/;
 
index a9234b2..0d703e8 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Waiting;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 7d60570..0734a5e 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test2::Util::HashBase qw/-details/;
 use Carp qw/croak/;
index 458de12..67f150d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::About;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -package -no_display };
index 020c885..8870707 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Amnesty;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 sub is_list { 1 }
 
index 6aec9ad..151ba9c 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Assert;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -pass -no_debug -number };
index 9d47b16..eae4138 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Control;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -global -terminate -halt -has_callback -encoding };
index 19607c7..6425568 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Error;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 sub facet_key { 'errors' }
 sub is_list { 1 }
index 2b113c5..c5cfb6d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Info;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 sub is_list { 1 }
 
index 079fcfd..a7dd9ca 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Meta;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use vars qw/$AUTOLOAD/;
index fe7fdf1..dcf9361 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Parent;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Carp qw/confess/;
 
index 8d093c4..e9f56f5 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Plan;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 use Test2::Util::HashBase qw{ -count -skip -none };
index 891e844..acf81d7 100644 (file)
@@ -2,7 +2,7 @@ package Test2::EventFacet::Trace;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
 
index da79839..b433ef0 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 my %ADDED;
index 5f68330..80d9b09 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Formatter::TAP;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Test2::Util qw/clone_io/;
 
index 27e6e73..3998a10 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Carp qw/carp croak confess/;
index cb300a1..ed36f4e 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Test2::Hub::Interceptor::Terminator();
index 66419a2..8d7fde6 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 1;
index 5b3c368..f34bd11 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
 use Test2::Util::HashBase qw/nested exit_code manual_skip_all/;
index aa692dd..d02edf3 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Test2::API::Instance;
@@ -10,6 +10,7 @@ use Test2::Util qw/get_tid/;
 use Test2::API qw{
     test2_init_done
     test2_ipc
+    test2_has_ipc
     test2_ipc_enable_polling
     test2_pid
     test2_stack
@@ -23,7 +24,7 @@ our @EXPORT_OK = qw/cull/;
 BEGIN { require Exporter; our @ISA = qw(Exporter) }
 
 sub import {
-    goto &Exporter::import unless test2_init_done();
+    goto &Exporter::import if test2_has_ipc || !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();
index 196621c..27b89ce 100644 (file)
@@ -2,11 +2,11 @@ package Test2::IPC::Driver;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Carp qw/confess/;
-use Test2::Util::HashBase qw{no_fatal};
+use Test2::Util::HashBase qw{no_fatal no_bail};
 
 use Test2::API qw/test2_ipc_add_driver/;
 
@@ -36,8 +36,11 @@ for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) {
 sub abort {
     my $self = shift;
     chomp(my ($msg) = @_);
+
+    $self->driver_abort($msg) if $self->can('driver_abort');
+
     print STDERR "IPC Fatal Error: $msg\n";
-    print STDOUT "not ok - IPC Fatal Error\n";
+    print STDOUT "Bail out! IPC Fatal Error: $msg\n" unless $self->no_bail;
 
     CORE::exit(255) unless $self->no_fatal;
 }
@@ -249,6 +252,12 @@ child processes and threads to complete.
 
 =over 4
 
+=item $ipc->driver_abort($msg)
+
+This is a hook called by C<< Test2::IPC::Driver->abort() >>. This is your
+chance to cleanup when an abort happens. You cannot prevent the abort, but you
+can gracefully except it.
+
 =item $bool = $ipc->use_shm()
 
 True if you want to make use of the L<Test2::API>/L<Test2::API::Instance> SHM.
index 74c4a72..ad2ed05 100644 (file)
@@ -2,12 +2,12 @@ package Test2::IPC::Driver::Files;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
 
-use Test2::Util::HashBase qw{tempdir event_id tid pid globals};
+use Test2::Util::HashBase qw{tempdir event_ids read_ids timeouts tid pid globals};
 
 use Scalar::Util qw/blessed/;
 use File::Temp();
@@ -39,7 +39,9 @@ sub init {
     print STDERR "\nIPC Temp Dir: $tmpdir\n\n"
         if $ENV{T2_KEEP_TEMPDIR};
 
-    $self->{+EVENT_ID} = 1;
+    $self->{+EVENT_IDS} = {};
+    $self->{+READ_IDS} = {};
+    $self->{+TIMEOUTS} = {};
 
     $self->{+TID} = get_tid();
     $self->{+PID} = $$;
@@ -66,8 +68,11 @@ sub event_file {
     $self->abort("'$e' is not an event object!")
         unless $type->isa('Test2::Event');
 
+    my $tid = get_tid();
+    my $eid = $self->{+EVENT_IDS}->{$hid}->{$$}->{$tid} += 1;
+
     my @type = split '::', $type;
-    my $name = join(ipc_separator, $hid, $$, get_tid(), $self->{+EVENT_ID}++, @type);
+    my $name = join(ipc_separator, $hid, $$, $tid, $eid, @type);
 
     return File::Spec->catfile($tempdir, $name);
 }
@@ -193,6 +198,20 @@ Error: $err
     return 1;
 }
 
+sub driver_abort {
+    my $self = shift;
+    my ($msg) = @_;
+
+    local ($@, $!, $?, $^E);
+    eval {
+        my $abort = File::Spec->catfile($self->{+TEMPDIR}, "ABORT");
+        open(my $fh, '>>', $abort) or die "Could not open abort file: $!";
+        print $fh $msg, "\n";
+        close($fh) or die "Could not close abort file: $!";
+        1;
+    } or warn $@;
+}
+
 sub cull {
     my $self = shift;
     my ($hid) = @_;
@@ -201,8 +220,25 @@ sub cull {
 
     opendir(my $dh, $tempdir) or $self->abort("could not open IPC temp dir ($tempdir)!");
 
+    my $read = $self->{+READ_IDS};
+    my $timeouts = $self->{+TIMEOUTS};
+
     my @out;
     for my $info (sort cmp_events map { $self->should_read_event($hid, $_) } readdir($dh)) {
+        unless ($info->{global}) {
+            my $next = $self->{+READ_IDS}->{$info->{hid}}->{$info->{pid}}->{$info->{tid}} ||= 1;
+
+            $timeouts->{$info->{file}} ||= time;
+
+            if ($next != $info->{eid}) {
+                # Wait up to N seconds for missing events
+                next unless 5 < time - $timeouts->{$info->{file}};
+                $self->abort("Missing event HID: $info->{hid}, PID: $info->{pid}, TID: $info->{tid}, EID: $info->{eid}.");
+            }
+
+            $self->{+READ_IDS}->{$info->{hid}}->{$info->{pid}}->{$info->{tid}} = $info->{eid} + 1;
+        }
+
         my $full = $info->{full_path};
         my $obj = $self->read_event_file($full);
         push @out => $obj;
@@ -239,6 +275,7 @@ sub parse_event_filename {
     my $type = join '::' => @parts;
 
     return {
+        file     => $file,
         ready    => $ready,
         complete => $complete,
         global   => $global,
@@ -255,6 +292,8 @@ sub should_read_event {
     my ($hid, $file) = @_;
 
     return if substr($file, 0, 1) eq '.';
+    return if substr($file, 0, 3) eq 'HUB';
+    CORE::exit(255) if $file eq 'ABORT';
 
     my $parsed = $self->parse_event_filename($file);
 
@@ -329,6 +368,14 @@ sub DESTROY {
 
     my $tempdir = $self->{+TEMPDIR};
 
+    my $aborted = 0;
+    my $abort_file = File::Spec->catfile($self->{+TEMPDIR}, "ABORT");
+    if (-e $abort_file) {
+        $aborted = 1;
+        my ($ok, $err) = do_unlink($abort_file);
+        warn $err unless $ok;
+    }
+
     opendir(my $dh, $tempdir) or $self->abort("Could not open temp dir! ($tempdir)");
     while(my $file = readdir($dh)) {
         next if $file =~ m/^\.+$/;
@@ -336,7 +383,7 @@ sub DESTROY {
         my $full = File::Spec->catfile($tempdir, $file);
 
         my $sep = ipc_separator;
-        if ($file =~ m/^(GLOBAL|HUB$sep)/) {
+        if ($aborted || $file =~ m/^(GLOBAL|HUB$sep)/) {
             $full =~ m/^(.*)$/;
             $full = $1; # Untaint it
             next if $ENV{T2_KEEP_TEMPDIR};
@@ -354,6 +401,8 @@ sub DESTROY {
         return;
     }
 
+    my $abort = File::Spec->catfile($self->{+TEMPDIR}, "ABORT");
+    unlink($abort) if -e $abort;
     rmdir($tempdir) or warn "Could not remove IPC temp dir ($tempdir)";
 }
 
index 40aeade..af51df4 100644 (file)
@@ -16,7 +16,7 @@ use Test2::API qw/context run_subtest test2_stack/;
 use Test2::Hub::Interceptor();
 use Test2::Hub::Interceptor::Terminator();
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 BEGIN { require Exporter; our @ISA = qw(Exporter) }
 our @EXPORT = qw{
index 638d25b..4449643 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use POSIX();
 use Config qw/%Config/;
index 9088c4e..4aa2e5d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 
 use Carp qw/croak/;
index 09992bd..1288a98 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::Facets2Legacy;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use Carp qw/croak confess/;
 use Scalar::Util qw/blessed/;
index 7e97284..6396ab0 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::HashBase;
 use strict;
 use warnings;
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 #################################################################
 #                                                               #
index e4f2d55..79f4c8d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::Trace;
 require Test2::EventFacet::Trace;
 @ISA = ('Test2::EventFacet::Trace');
 
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 1;
 
index 74133e8..9db2946 100644 (file)
@@ -1,5 +1,5 @@
 package ok;
-our $VERSION = '1.302113';
+our $VERSION = '1.302120';
 
 use strict;
 use Test::More ();
diff --git a/cpan/Test-Simple/t/Legacy/subtest/callback.t b/cpan/Test-Simple/t/Legacy/subtest/callback.t
new file mode 100644 (file)
index 0000000..097d1bf
--- /dev/null
@@ -0,0 +1,53 @@
+#!/usr/bin/perl -w
+
+# What happens when a subtest dies?
+
+use lib 't/lib';
+
+use strict;
+use Test::More;
+use Test::Builder;
+use Test2::API;
+
+my $Test = Test::Builder->new;
+
+my $step = 0;
+my @callback_calls = ();
+Test2::API::test2_add_callback_pre_subtest(
+    sub {
+        $Test->is_num(
+            $step,
+            0,
+            'pre-subtest callbacks should be invoked before the subtest',
+        );
+        ++$step;
+        push @callback_calls, [@_];
+    },
+);
+
+$Test->subtest(
+    (my $subtest_name='some subtest'),
+    (my $subtest_code=sub {
+         $Test->is_num(
+             $step,
+             1,
+             'subtest should be run after the pre-subtest callbacks',
+         );
+         ++$step;
+     }),
+    (my @subtest_args = (1,2,3)),
+);
+
+is_deeply(
+    \@callback_calls,
+    [[$subtest_name,$subtest_code,@subtest_args]],
+    'pre-subtest callbacks should be invoked with the expected arguments',
+);
+
+$Test->is_num(
+    $step,
+    2,
+    'the subtest should be run',
+);
+
+$Test->done_testing();
diff --git a/cpan/Test-Simple/t/Test2/behavior/Subtest_callback.t b/cpan/Test-Simple/t/Test2/behavior/Subtest_callback.t
new file mode 100644 (file)
index 0000000..ae4231b
--- /dev/null
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+
+use Test2::Tools::Tiny;
+
+use Test2::API qw/run_subtest intercept/;
+
+my $step = 0;
+my @callback_calls = ();
+Test2::API::test2_add_callback_pre_subtest(
+    sub {
+        is(
+            $step,
+            0,
+            'pre-subtest callbacks should be invoked before the subtest',
+        );
+        ++$step;
+        push @callback_calls, [@_];
+    },
+);
+
+run_subtest(
+    (my $subtest_name='some subtest'),
+    (my $subtest_code=sub {
+         is(
+             $step,
+             1,
+             'subtest should be run after the pre-subtest callbacks',
+         );
+         ++$step;
+     }),
+    undef,
+    (my @subtest_args = (1,2,3)),
+);
+
+is_deeply(
+    \@callback_calls,
+    [[$subtest_name,$subtest_code,@subtest_args]],
+    'pre-subtest callbacks should be invoked with the expected arguments',
+);
+
+is(
+    $step,
+    2,
+    'the subtest should be run',
+);
+
+done_testing;
index b709909..d7a8953 100644 (file)
@@ -148,6 +148,12 @@ ok($CLASS->can('test2_no_wait')->(), "no_wait is set");
 $CLASS->can('test2_no_wait')->(undef);
 ok(!$CLASS->can('test2_no_wait')->(), "no_wait is not set");
 
+ok($CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting enabled");
+$CLASS->can('test2_ipc_wait_disable')->();
+ok(!$CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting disabled");
+$CLASS->can('test2_ipc_wait_enable')->();
+ok($CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting enabled");
+
 my $pctx;
 sub tool_a($;$) {
     Test2::API::context_do {
index 10ba6eb..8e7e9a8 100644 (file)
@@ -36,6 +36,7 @@ is_deeply(
         context_acquire_callbacks => [],
         context_init_callbacks    => [],
         context_release_callbacks => [],
+        pre_subtest_callbacks     => [],
 
         stack => [],
     },
@@ -69,6 +70,7 @@ is_deeply(
         context_acquire_callbacks => [],
         context_init_callbacks    => [],
         context_release_callbacks => [],
+        pre_subtest_callbacks     => [],
 
         stack => [],
     },
@@ -154,6 +156,18 @@ like(
     "Exit callbacks must be coderefs"
 );
 
+$one->reset;
+$one->add_pre_subtest_callback($callback);
+is(@{$one->pre_subtest_callbacks}, 1, "added a pre-subtest callback");
+$one->add_pre_subtest_callback($callback);
+is(@{$one->pre_subtest_callbacks}, 2, "added another pre-subtest callback");
+
+like(
+    exception { $one->add_pre_subtest_callback({}) },
+    qr/Pre-subtest callbacks must be coderefs/,
+    "Pre-subtest callbacks must be coderefs"
+);
+
 if (CAN_REALLY_FORK) {
     $one->reset;
     my $pid = fork;
@@ -170,7 +184,18 @@ if (CAN_REALLY_FORK) {
         local $SIG{__WARN__} = sub { push @warnings => @_ };
         is(Test2::API::Instance::_ipc_wait, 255, "Process exited badly");
     }
-    like($warnings[0], qr/Process .* did not exit cleanly \(status: 255\)/, "Warn about exit");
+    like($warnings[0], qr/Process .* did not exit cleanly \(wstat: \S+, exit: 255, sig: 0\)/, "Warn about exit");
+
+    $pid = fork;
+    die "Failed to fork!" unless defined $pid;
+    unless($pid) { sleep 20; exit 0 }
+    kill('TERM', $pid) or die "Failed to send signal";
+    @warnings = ();
+    {
+        local $SIG{__WARN__} = sub { push @warnings => @_ };
+        is(Test2::API::Instance::_ipc_wait, 255, "Process exited badly");
+    }
+    like($warnings[0], qr/Process .* did not exit cleanly \(wstat: \S+, exit: 0, sig: 15\)/, "Warn about exit");
 }
 
 if (CAN_THREAD && $] ge '5.010') {
index ddd49c0..38be3b8 100644 (file)
@@ -2,7 +2,7 @@ use strict;
 use warnings;
 
 use Test2::IPC qw/cull/;
-use Test2::API qw/context test2_ipc_drivers test2_ipc/;
+use Test2::API qw/context test2_ipc_drivers test2_ipc intercept/;
 
 use Test2::Tools::Tiny;
 
@@ -16,4 +16,6 @@ is_deeply(
 
 ok(__PACKAGE__->can('cull'), "Imported cull");
 
+ok(eval { intercept { Test2::IPC->import }; 1 }, "Can re-import Test2::IPC without error") or diag $@;
+
 done_testing;
index 0f01328..d5ebbd5 100644 (file)
@@ -40,7 +40,7 @@ tests abort => sub {
     }
 
     is($err, "IPC Fatal Error: foo\n", "Got error");
-    is($out, "not ok - IPC Fatal Error\n", "got 'not ok' on stdout");
+    is($out, "Bail out! IPC Fatal Error: foo\n", "got 'bail-out' on stdout");
 
     ($err, $out) = ("", "");
 
@@ -52,7 +52,7 @@ tests abort => sub {
         $one->abort_trace('foo');
     }
 
-    is($out, "not ok - IPC Fatal Error\n", "got 'not ok' on stdout");
+    like($out, qr/Bail out! IPC Fatal Error: foo/, "got 'bail-out' on stdout");
     like($err, qr/IPC Fatal Error: foo/, "Got error");
 };
 }
index 9ca1f5c..8626b1f 100644 (file)
@@ -130,10 +130,12 @@ ok(!-d $tmpdir, "cleaned up temp dir");
 }
 
 {
-    no warnings 'once';
+    no warnings qw/once redefine/;
+    local *Test2::IPC::Driver::Files::driver_abort = sub {};
     local *Test2::IPC::Driver::Files::abort = sub {
         my $self = shift;
         local $self->{no_fatal} = 1;
+        local $self->{no_bail} = 1;
         $self->Test2::IPC::Driver::abort(@_);
         die 255;
     };
@@ -175,8 +177,6 @@ ok(!-d $tmpdir, "cleaned up temp dir");
     };
     $cleanup->();
 
-    is($out->{STDOUT}, "not ok - IPC Fatal Error\nnot ok - IPC Fatal Error\n", "printed ");
-
     like($out->{STDERR}, qr/IPC Temp Dir: \Q$tmpdir\E/m, "Got temp dir path");
     like($out->{STDERR}, qr/^# Not removing temp dir: \Q$tmpdir\E$/m, "Notice about not closing tempdir");
 
@@ -365,6 +365,7 @@ ok(!-d $tmpdir, "cleaned up temp dir");
             pid      => "123",
             tid      => "456",
             eid      => "789",
+            file     => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
         },
         "Parsed global complete"
     );
@@ -380,6 +381,7 @@ ok(!-d $tmpdir, "cleaned up temp dir");
             pid      => "123",
             tid      => "456",
             eid      => "789",
+            file     => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
         },
         "Parsed global ready"
     );
@@ -395,6 +397,7 @@ ok(!-d $tmpdir, "cleaned up temp dir");
             pid      => "123",
             tid      => "456",
             eid      => "789",
+            file     => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
         },
         "Parsed global not ready"
     );
@@ -410,6 +413,7 @@ ok(!-d $tmpdir, "cleaned up temp dir");
             pid      => "123",
             tid      => "456",
             eid      => "789",
+            file     => join ipc_separator, qw'1 1 1 123 456 789 Event Type Foo',
         },
         "Parsed event complete"
     );
@@ -425,6 +429,7 @@ ok(!-d $tmpdir, "cleaned up temp dir");
             pid      => "123",
             tid      => "456",
             eid      => "789",
+            file     => join ipc_separator, qw'1 2 3 123 456 789 Event Type Foo',
         },
         "Parsed event ready"
     );
@@ -440,6 +445,7 @@ ok(!-d $tmpdir, "cleaned up temp dir");
             pid      => "123",
             tid      => "456",
             eid      => "789",
+            file     => join ipc_separator, qw'3 2 11 123 456 789 Event',
         },
         "Parsed event not ready"
     );
index 772d12a..b425443 100644 (file)
@@ -1,63 +1,67 @@
 use strict;
 use warnings;
-use Test2::IPC;
 use Test2::Tools::Tiny;
-use Test2::API qw/context test2_stack/;
 use Test2::Util qw/CAN_FORK/;
 
 BEGIN {
+    skip_all "Set AUTHOR_TESTING to run this test" unless $ENV{AUTHOR_TESTING};
     skip_all "System cannot fork" unless CAN_FORK;
     skip_all "known to fail on $]" if $] le "5.006002";
 }
 
-plan(3);
+use IPC::Open3 qw/open3/;
+use File::Temp qw/tempdir/;
 
-pipe(my ($read, $write));
+my $tempdir = tempdir(CLEANUP => 1);
 
-test2_stack()->top;
-my $hub = test2_stack()->new_hub();
+open(my $stdout, '>', "$tempdir/stdout") or die "Could not open: $!";
+open(my $stderr, '>', "$tempdir/stderr") or die "Could not open: $!";
 
-my $pid = fork();
-die "Failed to fork" unless defined $pid;
+my $pid = open3(undef, ">&" . fileno($stdout), ">&" . fileno($stderr), $^X, '-Ilib', '-e', <<'EOT');
+use Test2::IPC::Driver::Files;
+use Test2::IPC;
+use Test2::Tools::Tiny;
+use Test2::API qw/test2_ipc/;
+plan 1;
+ok(1);
 
-if ($pid) {
-    close($read);
-    test2_stack()->pop($hub);
-    $hub = undef;
-    print $write "Go\n";
-    close($write);
-    waitpid($pid, 0);
-    my $err = $? >> 8;
-    is($err, 255, "Exit code was not masked");
-    ok($err != 100, "Did not hit the safety exit");
-}
-else {
-    close($write);
-    my $ignore = <$read>;
-    close($read);
-    close(STDERR);
-    close(STDOUT);
-    open(STDERR, '>', my $x);
-    my $ctx = context(hub => $hub, level => -1);
-    my $clone = $ctx->snapshot;
-    $ctx->release;
-    $clone->ok(0, "Should not see this");
-    print STDERR "\n\nSomething went wrong!!!!\n\n";
-    exit 100; # Safety exit
-};
-
-
-# The rest of this is to make sure nothing that happens when reading the event
-# messes with $?.
-
-pipe($read, $write);
-
-$pid = fork;
-die "Failed to fork" unless defined $pid;
-
-unless($pid) {
-    my $ignore = <$read>;
-    ok(1, "Test in forked process");
+my $tmpdir = test2_ipc()->tempdir;
+open(my $fh, '>', "$tmpdir/leftover") or die "Could not open file: $!";
+print $fh "XXX\n";
+close($fh) or die "Could not clone file";
+
+print "TEMPDIR: $tmpdir\n";
+
+exit 100;
+
+EOT
+
+waitpid($pid, 0);
+my $exit = $?;
+
+open($stdout, '<', "$tempdir/stdout") or die "Could not open: $!";
+open($stderr, '<', "$tempdir/stderr") or die "Could not open: $!";
+
+$stdout = join "" => <$stdout>;
+$stderr = join "" => <$stderr>;
+
+is(($exit >> 8), 255, "exited 255");
+like($stderr, qr{^IPC Fatal Error: Leftover files in the directory \(.*/leftover\)!$}m, "Got expected error");
+like($stdout, qr{^Bail out! IPC Fatal Error: Leftover files in the directory \(.*leftover\)!$}m, "Got a bail printed");
+
+if(ok($stdout =~ m/^TEMPDIR: (.*)$/m, "Found temp dir")) {
+    chomp(my $tmpdir = $1);
+    if (-d $tmpdir) {
+        note "Cleaning up temp dir\n";
+
+        opendir(my $dh, $tmpdir) or diag "Could not open temp dir: $!";
+        for my $file (readdir($dh)) {
+            next if $file =~ m/^\./;
+            unlink("$tmpdir/$file") or diag "Could not remove $tmpdir/$file: $!";
+        }
+        closedir($dh);
+        rmdir($tmpdir) or diag "Could not remove temp dir: $!";
+    }
 }
 
-print $write "Go\n";
+done_testing;