In perl.git, the branch smoke-me/jkeenan/d_uselocale-freebsd has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/7654f0da005e5d7922f57aa3d5f45ceacdc10165?hp=bb20662386285f410412584416d18b5857ed82a9> discards bb20662386285f410412584416d18b5857ed82a9 (commit) - Log ----------------------------------------------------------------- commit 7654f0da005e5d7922f57aa3d5f45ceacdc10165 Author: James E Keenan <[email protected]> Date: Tue Nov 28 22:07:18 2017 -0500 Relax workaround for d_uselocale from RT #128867. More precisely, tailor the application of the workaround to the FreeBSD kernel version ranges specified in https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=211743#c10. We probably don't need an 'else' branch; let Configure handle it. ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + MANIFEST | 2 + Porting/Maintainers.pl | 9 +- charclass_invlists.h | 2 +- cpan/Test-Simple/lib/Test/Builder.pm | 6 +- cpan/Test-Simple/lib/Test/Builder/Formatter.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/Module.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/Tester.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm | 2 +- cpan/Test-Simple/lib/Test/More.pm | 2 +- cpan/Test-Simple/lib/Test/Simple.pm | 2 +- cpan/Test-Simple/lib/Test/Tester.pm | 2 +- cpan/Test-Simple/lib/Test/Tester/Capture.pm | 2 +- cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm | 2 +- cpan/Test-Simple/lib/Test/Tester/Delegate.pm | 2 +- cpan/Test-Simple/lib/Test/use/ok.pm | 2 +- cpan/Test-Simple/lib/Test2.pm | 2 +- cpan/Test-Simple/lib/Test2/API.pm | 55 ++++++- cpan/Test-Simple/lib/Test2/API/Breakage.pm | 2 +- cpan/Test-Simple/lib/Test2/API/Context.pm | 2 +- cpan/Test-Simple/lib/Test2/API/Instance.pm | 34 ++++- cpan/Test-Simple/lib/Test2/API/Stack.pm | 2 +- cpan/Test-Simple/lib/Test2/Event.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Bail.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Diag.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Encoding.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Exception.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Fail.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Generic.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Note.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Ok.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Pass.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Plan.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Skip.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Subtest.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Waiting.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/About.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Control.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Error.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Info.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm | 2 +- cpan/Test-Simple/lib/Test2/Formatter.pm | 2 +- cpan/Test-Simple/lib/Test2/Formatter/TAP.pm | 2 +- cpan/Test-Simple/lib/Test2/Hub.pm | 2 +- cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm | 2 +- .../lib/Test2/Hub/Interceptor/Terminator.pm | 2 +- cpan/Test-Simple/lib/Test2/Hub/Subtest.pm | 2 +- cpan/Test-Simple/lib/Test2/IPC.pm | 5 +- cpan/Test-Simple/lib/Test2/IPC/Driver.pm | 15 +- cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm | 59 +++++++- cpan/Test-Simple/lib/Test2/Tools/Tiny.pm | 2 +- cpan/Test-Simple/lib/Test2/Util.pm | 2 +- cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm | 2 +- cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm | 2 +- cpan/Test-Simple/lib/Test2/Util/HashBase.pm | 2 +- cpan/Test-Simple/lib/Test2/Util/Trace.pm | 2 +- cpan/Test-Simple/lib/ok.pm | 2 +- cpan/Test-Simple/t/Legacy/subtest/callback.t | 53 +++++++ .../t/Test2/behavior/Subtest_callback.t | 48 ++++++ cpan/Test-Simple/t/Test2/modules/API.t | 6 + cpan/Test-Simple/t/Test2/modules/API/Instance.t | 27 +++- cpan/Test-Simple/t/Test2/modules/IPC.t | 4 +- cpan/Test-Simple/t/Test2/modules/IPC/Driver.t | 4 +- .../Test-Simple/t/Test2/modules/IPC/Driver/Files.t | 12 +- .../t/Test2/regression/ipc_files_abort_exit.t | 98 +++++++------ cpan/experimental/lib/experimental.pm | 6 +- cpan/experimental/t/basic.t | 11 +- dist/IO/t/io_utf8argv.t | 6 +- doio.c | 163 ++++++++++++++------- ext/POSIX/POSIX.xs | 1 - hints/freebsd.sh | 2 - hints/netbsd.sh | 11 ++ hv_func.h | 8 +- lib/unicore/mktables | 74 ++++++++-- locale.c | 2 +- op.c | 2 +- perl.h | 2 +- pod/perlfunc.pod | 18 +-- pp_sys.c | 13 +- regcharclass.h | 2 +- regcomp.c | 2 + stadtx_hash.h | 32 ++-- sv.c | 1 + t/run/switches.t | 5 +- 92 files changed, 652 insertions(+), 259 deletions(-) create mode 100644 cpan/Test-Simple/t/Legacy/subtest/callback.t create mode 100644 cpan/Test-Simple/t/Test2/behavior/Subtest_callback.t diff --git a/AUTHORS b/AUTHORS index db0921650a..e2c794510e 100644 --- a/AUTHORS +++ b/AUTHORS @@ -771,6 +771,7 @@ Marc Lehmann <[email protected]> Marc Paquette <[email protected]> Marc Simpson <[email protected]> Marcel Grünauer <[email protected]> +Marco Fontani <[email protected]> Marco Peereboom <[email protected]> Marcus Holland-Moritz <[email protected]> Marek Rouchal <[email protected]> diff --git a/MANIFEST b/MANIFEST index 093cb7e016..27ffee5299 100644 --- 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 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 1586ea7e9b..2ed349e2e3 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -406,9 +406,12 @@ use File::Glob qw(:case); }, 'experimental' => { - 'DISTRIBUTION' => 'LEONT/experimental-0.017.tar.gz', + 'DISTRIBUTION' => 'LEONT/experimental-0.018.tar.gz', 'FILES' => q[cpan/experimental], - 'EXCLUDED' => [qr{^xt/}], + 'EXCLUDED' => [ + qr{^xt/}, + qr{nytprof.*} + ], }, 'Exporter' => { @@ -1071,7 +1074,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/}, diff --git a/charclass_invlists.h b/charclass_invlists.h index 69b42b36f0..841820512c 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -97454,7 +97454,7 @@ static const U8 WB_table[24][24] = { * be0f129691d479aa38646e4ca0ec1ee576ae7f75b0300a5624a7fa862fa8abba lib/unicore/extracted/DLineBreak.txt * 92449d354d9f6b6f2f97a292ebb59f6344ffdeb83d120d7d23e569c43ba67cd5 lib/unicore/extracted/DNumType.txt * e3a319527153b0c6c0c549b40fc6f3a01a7a0dcd6620784391db25901df3b154 lib/unicore/extracted/DNumValues.txt - * c145400bb109fc28371c48e1fcde2e55d44c35ac561b38613cfd7ed235ceead3 lib/unicore/mktables + * 7e82d9210fb1c8ffadda5a3a04912fc34a165bfe98ac80c1669c1e67c3de044a lib/unicore/mktables * 21653d2744fdd071f9ef138c805393901bb9547cf3e777ebf50215a191f986ea lib/unicore/version * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl * 48418cbf454eb9ef35c73468ed5ef72ad8603490eabe74181ce4fae42ec72579 regen/mk_invlists.pl diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index dc2ddc6418..8db992f5bf 100644 --- a/cpan/Test-Simple/lib/Test/Builder.pm +++ b/cpan/Test-Simple/lib/Test/Builder.pm @@ -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); diff --git a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm index a828d218dc..caaa78d4df 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index 8b8da6127c..8cfd4519ce 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -7,7 +7,7 @@ use Test::Builder; require Exporter; our @ISA = qw(Exporter); -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; =head1 NAME diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index 9d885af4e6..6c304baedf 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester; use strict; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Test::Builder; use Symbol; diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm index 8b7cde15e0..6dd6c67c46 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester::Color; use strict; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; require Test::Builder::Tester; diff --git a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm index b4c6d2ed51..fd4e5699e2 100644 --- a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm +++ b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index 25237e8b56..27b7d14d02 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -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); diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index 20c49aceef..7697928b09 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -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); diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm index 81c3aed0a5..f19ca742d4 100644 --- a/cpan/Test-Simple/lib/Test/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Tester.pm @@ -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 ); diff --git a/cpan/Test-Simple/lib/Test/Tester/Capture.pm b/cpan/Test-Simple/lib/Test/Tester/Capture.pm index a4038611cd..8f196f5242 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Capture.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Capture.pm @@ -2,7 +2,7 @@ use strict; package Test::Tester::Capture; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Test::Builder; diff --git a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm index 54a706420f..4b2ea9dd20 100644 --- a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm +++ b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm @@ -3,7 +3,7 @@ use strict; package Test::Tester::CaptureRunner; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Test::Tester::Capture; diff --git a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm index 88f3493998..3275fc7a4c 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm @@ -3,7 +3,7 @@ use warnings; package Test::Tester::Delegate; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Scalar::Util(); diff --git a/cpan/Test-Simple/lib/Test/use/ok.pm b/cpan/Test-Simple/lib/Test/use/ok.pm index 33ece84c11..bbd2d07715 100644 --- a/cpan/Test-Simple/lib/Test/use/ok.pm +++ b/cpan/Test-Simple/lib/Test/use/ok.pm @@ -1,7 +1,7 @@ package Test::use::ok; use 5.005; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; __END__ diff --git a/cpan/Test-Simple/lib/Test2.pm b/cpan/Test-Simple/lib/Test2.pm index dc604e5182..e7d5fbd28d 100644 --- a/cpan/Test-Simple/lib/Test2.pm +++ b/cpan/Test-Simple/lib/Test2.pm @@ -2,7 +2,7 @@ package Test2; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; 1; diff --git a/cpan/Test-Simple/lib/Test2/API.pm b/cpan/Test-Simple/lib/Test2/API.pm index ea9199aa59..20d0d6ef9d 100644 --- a/cpan/Test-Simple/lib/Test2/API.pm +++ b/cpan/Test-Simple/lib/Test2/API.pm @@ -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 diff --git a/cpan/Test-Simple/lib/Test2/API/Breakage.pm b/cpan/Test-Simple/lib/Test2/API/Breakage.pm index 75120bc382..13e87bc9c5 100644 --- a/cpan/Test-Simple/lib/Test2/API/Breakage.pm +++ b/cpan/Test-Simple/lib/Test2/API/Breakage.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/API/Context.pm b/cpan/Test-Simple/lib/Test2/API/Context.pm index e3cf0bc1ba..241af69896 100644 --- a/cpan/Test-Simple/lib/Test2/API/Context.pm +++ b/cpan/Test-Simple/lib/Test2/API/Context.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/API/Instance.pm b/cpan/Test-Simple/lib/Test2/API/Instance.pm index f0fc711f3d..92f442b562 100644 --- a/cpan/Test-Simple/lib/Test2/API/Instance.pm +++ b/cpan/Test-Simple/lib/Test2/API/Instance.pm @@ -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 diff --git a/cpan/Test-Simple/lib/Test2/API/Stack.pm b/cpan/Test-Simple/lib/Test2/API/Stack.pm index e0fc191e1a..1eea110d2f 100644 --- a/cpan/Test-Simple/lib/Test2/API/Stack.pm +++ b/cpan/Test-Simple/lib/Test2/API/Stack.pm @@ -2,7 +2,7 @@ package Test2::API::Stack; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Test2::Hub(); diff --git a/cpan/Test-Simple/lib/Test2/Event.pm b/cpan/Test-Simple/lib/Test2/Event.pm index a85690cb77..fc30caf45b 100644 --- a/cpan/Test-Simple/lib/Test2/Event.pm +++ b/cpan/Test-Simple/lib/Test2/Event.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Bail.pm b/cpan/Test-Simple/lib/Test2/Event/Bail.pm index e7577a0b90..0cc9c7dfcb 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Bail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Bail.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Diag.pm b/cpan/Test-Simple/lib/Test2/Event/Diag.pm index 2c2d68616b..a64e1bb4ba 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Diag.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Diag.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Encoding.pm b/cpan/Test-Simple/lib/Test2/Event/Encoding.pm index 9ad4eda659..67222ae799 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Encoding.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Encoding.pm @@ -2,7 +2,7 @@ package Test2::Event::Encoding; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Exception.pm b/cpan/Test-Simple/lib/Test2/Event/Exception.pm index 3bcb7a8410..bb031e3b69 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Exception.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Exception.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Fail.pm b/cpan/Test-Simple/lib/Test2/Event/Fail.pm index 98cad31f38..e73f061284 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Fail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Fail.pm @@ -2,7 +2,7 @@ package Test2::Event::Fail; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Test2::EventFacet::Info; diff --git a/cpan/Test-Simple/lib/Test2/Event/Generic.pm b/cpan/Test-Simple/lib/Test2/Event/Generic.pm index f3ffe33881..fcaf6dd79a 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Generic.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Generic.pm @@ -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; diff --git a/cpan/Test-Simple/lib/Test2/Event/Note.pm b/cpan/Test-Simple/lib/Test2/Event/Note.pm index 76f3c064bf..640e2501f5 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Note.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Note.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Ok.pm b/cpan/Test-Simple/lib/Test2/Event/Ok.pm index 924136fd3d..5fc25862ee 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Ok.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Ok.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Pass.pm b/cpan/Test-Simple/lib/Test2/Event/Pass.pm index 744eff75bb..0c8e15d3aa 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Pass.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Pass.pm @@ -2,7 +2,7 @@ package Test2::Event::Pass; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Test2::EventFacet::Info; diff --git a/cpan/Test-Simple/lib/Test2/Event/Plan.pm b/cpan/Test-Simple/lib/Test2/Event/Plan.pm index 8e4d646633..b4393de7cd 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Plan.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Skip.pm b/cpan/Test-Simple/lib/Test2/Event/Skip.pm index 4c28c31a3c..ee01d7e1c9 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Skip.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Skip.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm index 8678a9d416..4465261eb9 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm @@ -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}; diff --git a/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm b/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm index 7a81df31c8..3fabbaeb32 100644 --- a/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm +++ b/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm index a9234b2b8c..0d703e88e0 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet.pm b/cpan/Test-Simple/lib/Test2/EventFacet.pm index 7d6057077b..0734a5e720 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/About.pm b/cpan/Test-Simple/lib/Test2/EventFacet/About.pm index 458de12a0e..67f150d945 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/About.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/About.pm @@ -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 }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm index 020c885d1d..8870707d75 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Amnesty; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; sub is_list { 1 } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm index 6aec9ad33e..151ba9c41f 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm @@ -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 }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm index 9d47b1647e..eae4138e98 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm @@ -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 }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm index 19607c7fd0..6425568b77 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm @@ -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 } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm index 2b113c56a0..c5cfb6d616 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Info; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; sub is_list { 1 } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm index 079fcfdf0d..a7dd9caac4 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm index fe7fdf1290..dcf9361436 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Parent; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Carp qw/confess/; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm index 8d093c4b11..e9f56f5a51 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm @@ -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 }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm index 891e844569..acf81d7d0b 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm @@ -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) } diff --git a/cpan/Test-Simple/lib/Test2/Formatter.pm b/cpan/Test-Simple/lib/Test2/Formatter.pm index da79839b31..b433ef0c8a 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter.pm @@ -2,7 +2,7 @@ package Test2::Formatter; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; my %ADDED; diff --git a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm index 5f683306c0..80d9b09079 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/Hub.pm b/cpan/Test-Simple/lib/Test2/Hub.pm index 27e6e73702..3998a10606 100644 --- a/cpan/Test-Simple/lib/Test2/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/Hub.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm index cb300a139a..ed36f4e250 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm @@ -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(); diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm index 66419a21e1..8d7fde6e27 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm @@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; 1; diff --git a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm index 5b3c368698..f34bd11314 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/IPC.pm b/cpan/Test-Simple/lib/Test2/IPC.pm index aa692dda7f..d02edf34bb 100644 --- a/cpan/Test-Simple/lib/Test2/IPC.pm +++ b/cpan/Test-Simple/lib/Test2/IPC.pm @@ -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(); diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm index 196621c358..27b89ce9ec 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm @@ -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. diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm index 74c4a72b79..ad2ed056a5 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm @@ -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)"; } diff --git a/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm b/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm index 40aeade928..af51df47e7 100644 --- a/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm +++ b/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm @@ -16,7 +16,7 @@ use Test2::API qw/context run_subtest test2_stack/; use Test2::Hub::Interceptor(); use Test2::Hub::Interceptor::Terminator(); -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; BEGIN { require Exporter; our @ISA = qw(Exporter) } our @EXPORT = qw{ diff --git a/cpan/Test-Simple/lib/Test2/Util.pm b/cpan/Test-Simple/lib/Test2/Util.pm index 638d25bf3d..444964341f 100644 --- a/cpan/Test-Simple/lib/Test2/Util.pm +++ b/cpan/Test-Simple/lib/Test2/Util.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm index 9088c4ee74..4aa2e5dfb3 100644 --- a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm +++ b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm @@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm b/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm index 09992bdb22..1288a985da 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm @@ -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/; diff --git a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm index 7e97284159..6396ab0ace 100644 --- a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm +++ b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm @@ -2,7 +2,7 @@ package Test2::Util::HashBase; use strict; use warnings; -our $VERSION = '1.302113'; +our $VERSION = '1.302120'; ################################################################# # # diff --git a/cpan/Test-Simple/lib/Test2/Util/Trace.pm b/cpan/Test-Simple/lib/Test2/Util/Trace.pm index e4f2d55eb8..79f4c8dab3 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Trace.pm @@ -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; diff --git a/cpan/Test-Simple/lib/ok.pm b/cpan/Test-Simple/lib/ok.pm index 74133e8233..9db2946054 100644 --- a/cpan/Test-Simple/lib/ok.pm +++ b/cpan/Test-Simple/lib/ok.pm @@ -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 index 0000000000..097d1bf2c0 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/callback.t @@ -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 index 0000000000..ae4231b629 --- /dev/null +++ b/cpan/Test-Simple/t/Test2/behavior/Subtest_callback.t @@ -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; diff --git a/cpan/Test-Simple/t/Test2/modules/API.t b/cpan/Test-Simple/t/Test2/modules/API.t index b709909720..d7a895377d 100644 --- a/cpan/Test-Simple/t/Test2/modules/API.t +++ b/cpan/Test-Simple/t/Test2/modules/API.t @@ -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 { diff --git a/cpan/Test-Simple/t/Test2/modules/API/Instance.t b/cpan/Test-Simple/t/Test2/modules/API/Instance.t index 10ba6ebad1..8e7e9a8a3b 100644 --- a/cpan/Test-Simple/t/Test2/modules/API/Instance.t +++ b/cpan/Test-Simple/t/Test2/modules/API/Instance.t @@ -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') { diff --git a/cpan/Test-Simple/t/Test2/modules/IPC.t b/cpan/Test-Simple/t/Test2/modules/IPC.t index ddd49c0d9e..38be3b8f10 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC.t @@ -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; diff --git a/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t b/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t index 0f013286bc..d5ebbd5fd2 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t @@ -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"); }; } diff --git a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t index 9ca1f5c84e..8626b1fb65 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t @@ -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" ); diff --git a/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t b/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t index 772d12acbc..b425443e00 100644 --- a/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t +++ b/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t @@ -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; diff --git a/cpan/experimental/lib/experimental.pm b/cpan/experimental/lib/experimental.pm index 0d69faafb4..e6907c0b8b 100644 --- a/cpan/experimental/lib/experimental.pm +++ b/cpan/experimental/lib/experimental.pm @@ -1,10 +1,10 @@ package experimental; -$experimental::VERSION = '0.017'; +$experimental::VERSION = '0.018'; use strict; use warnings; use version (); -use feature (); +BEGIN { eval { require feature } }; use Carp qw/croak carp/; my %warnings = map { $_ => 1 } grep { /^experimental::/ } keys %warnings::Offsets; @@ -130,7 +130,7 @@ experimental - Experimental features made easy =head1 VERSION -version 0.017 +version 0.018 =head1 SYNOPSIS diff --git a/cpan/experimental/t/basic.t b/cpan/experimental/t/basic.t index a270fdfd91..5be845b38d 100644 --- a/cpan/experimental/t/basic.t +++ b/cpan/experimental/t/basic.t @@ -1,5 +1,8 @@ #! perl +use strict; +use warnings; + use Test::More 0.89; local $SIG{__WARN__} = sub { fail("Got unexpected warning"); diag($_[0]) }; @@ -12,9 +15,6 @@ if ($] >= 5.010000) { 1; END } -else { - fail("No experimental features available on perl $]"); -} if ($] >= 5.010001) { is (eval <<'END', 1, 'switch compiles') or diag $@; @@ -35,8 +35,8 @@ END if ($] >= 5.010001) { is (eval <<'END', 1, 'smartmatch compiles') or diag $@; use experimental 'smartmatch'; - sub bar { 1 }; - is(1 ~~ \&bar, 1, "is 1"); + sub baz { 1 }; + is(1 ~~ \&baz, 1, "is 1"); 1; END } @@ -53,6 +53,7 @@ END if ($] >= 5.021005) { is (eval <<'END', 1, 'ref aliasing compiles') or diag $@; use experimental 'refaliasing'; + my (@a, @b); \@a = \@b; is(\@a, \@b, '@a and @b are the same after \@a=\@b'); 1; diff --git a/dist/IO/t/io_utf8argv.t b/dist/IO/t/io_utf8argv.t index d6485f45dd..2531ca6cec 100644 --- a/dist/IO/t/io_utf8argv.t +++ b/dist/IO/t/io_utf8argv.t @@ -5,7 +5,7 @@ BEGIN { print "1..0 # Skip: not perlio\n"; exit 0; } - require($ENV{PERL_CORE} ? "../../t/test.pl" : "../t/test.pl"); + require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); } use utf8; @@ -22,7 +22,7 @@ my $bytes = "\xcd\xbe\x0a"; if ($::IS_EBCDIC) { - require($ENV{PERL_CORE} ? "../../t/charset_tools.pl" : "../t/charset_tools.pl"); + require($ENV{PERL_CORE} ? "../../t/charset_tools.pl" : "./t/charset_tools.pl"); $bytes = byte_utf8a_to_utf8n($bytes) } @@ -44,4 +44,4 @@ is join('',*ARGV->getlines), "Μία πάπια, μὰ ποιὰ πάπια; END { 1 while unlink "io_utf8argv"; -} +} \ No newline at end of file diff --git a/doio.c b/doio.c index 7dcbbb5cfb..9f76c10ea4 100644 --- a/doio.c +++ b/doio.c @@ -621,6 +621,8 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PERL_ARGS_ASSERT_OPENN_CLEANUP; + Zero(&statbuf, 1, Stat_t); + if (!fp) { if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE) && should_warn_nl(oname) @@ -850,7 +852,11 @@ S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) { else sv_setpvs(temp_out_name, "XXXXXXXX"); - fd = Perl_my_mkstemp(SvPVX(temp_out_name)); + { + int old_umask = umask(0177); + fd = Perl_my_mkstemp(SvPVX(temp_out_name)); + umask(old_umask); + } if (fd < 0) return FALSE; @@ -871,10 +877,8 @@ S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) { /* Win32 doesn't necessarily return useful information * in st_dev, st_ino. */ -#ifndef ARGV_USE_ATFUNCTIONS -# ifndef DOSISH -# define ARGV_USE_STAT_INO -# endif +#ifndef DOSISH +# define ARGV_USE_STAT_INO #endif #define ARGVMG_BACKUP_NAME 0 @@ -883,21 +887,32 @@ S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) { #define ARGVMG_ORIG_MODE 3 #define ARGVMG_ORIG_PID 4 -#if defined(ARGV_USE_ATFUNCTIONS) -#define ARGVMG_ORIG_DIRP 5 -#elif defined(ARGV_USE_STAT_INO) /* we store the entire stat_t since the ino_t and dev_t values might not fit in an IV. I could have created a new structure and transferred them across, but this seemed too much effort for very little win. + + We store it even when the *at() functions are available, since + while the C runtime might have definitions for these functions, the + operating system or a specific filesystem might not implement them. + eg. NetBSD 6 implements linkat() but only where the fds are AT_FDCWD. */ -#define ARGVMG_ORIG_CWD_STAT 5 +#ifdef ARGV_USE_STAT_INO +# define ARGVMG_ORIG_CWD_STAT 5 +#endif + +#ifdef ARGV_USE_ATFUNCTIONS +# define ARGVMG_ORIG_DIRP 6 +#endif + +#ifdef ENOTSUP +#define NotSupported(e) ((e) == ENOSYS || (e) == ENOTSUP) +#else +#define NotSupported(e) ((e) == ENOSYS) #endif static int S_argvout_free(pTHX_ SV *io, MAGIC *mg) { - SV **temp_psv; - PERL_UNUSED_ARG(io); /* note this can be entered once the file has been @@ -924,20 +939,24 @@ S_argvout_free(pTHX_ SV *io, MAGIC *mg) { /* if we get here the file hasn't been closed explicitly by the user and hadn't been closed implicitly by nextargv(), so abandon the edit */ + SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE); + const char *temp_pv = SvPVX(*temp_psv); + + assert(temp_psv && *temp_psv && SvPOK(*temp_psv)); (void)PerlIO_close(iop); IoIFP(io) = IoOFP(io) = NULL; - temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE); - assert(temp_psv && *temp_psv && SvPOK(*temp_psv)); #ifdef ARGV_USE_ATFUNCTIONS dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE); assert(dir_psv && *dir_psv && SvIOK(*dir_psv)); dir = INT2PTR(DIR *, SvIV(*dir_psv)); if (dir) { - (void)unlinkat(my_dirfd(dir), SvPVX(*temp_psv), 0); + if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 && + NotSupported(errno)) ... 609 lines suppressed ... -- Perl5 Master Repository
