In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3e02f6952c507a271dd4273c1cb0f06748cf8a30?hp=8a329a1f6ab42e0ee381a1b516a3cce4f61d9461>
- Log ----------------------------------------------------------------- commit 3e02f6952c507a271dd4273c1cb0f06748cf8a30 Author: Chad Granum <[email protected]> Date: Fri Dec 12 15:34:25 2014 -0800 Test-Simple Version Bump, 1.301001_087 (RC7) ----------------------------------------------------------------------- Summary of changes: cpan/Test-Simple/lib/Test/Builder.pm | 11 ++--- 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/More.pm | 2 +- cpan/Test-Simple/lib/Test/Simple.pm | 4 +- cpan/Test-Simple/lib/Test/Stream.pm | 2 +- cpan/Test-Simple/lib/Test/Stream/Util.pm | 56 +++++++++++++++++++++-- cpan/Test-Simple/lib/Test/Tester.pm | 2 +- cpan/Test-Simple/lib/Test/use/ok.pm | 2 +- cpan/Test-Simple/lib/ok.pm | 2 +- cpan/Test-Simple/t/Legacy/fork_die.t | 11 +---- cpan/Test-Simple/t/Legacy/subtest/fork.t | 18 +++----- cpan/Test-Simple/t/Test-Stream-API.t | 7 --- 14 files changed, 73 insertions(+), 50 deletions(-) diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index fbd2dbf..b2ccd47 100644 --- a/cpan/Test-Simple/lib/Test/Builder.pm +++ b/cpan/Test-Simple/lib/Test/Builder.pm @@ -4,7 +4,7 @@ use 5.008001; use strict; use warnings; -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) @@ -867,13 +867,10 @@ sub _try { my $error; my $return; - { - local $!; # eval can mess up $! - local $@; # don't set $@ in the test - local $SIG{__DIE__}; # don't trip an outside DIE handler. + protect { $return = eval { $code->() }; $error = $@; - } + }; die $error if $error and $opts{die_on_fail}; @@ -1049,7 +1046,7 @@ Check if something is a filehandle =item $TB->level -Get/Set C<$Test::Builder::Level>. $Level is a package var, and most thigns +Get/Set C<$Test::Builder::Level>. $Level is a package var, and most things localize it, so this method is pretty useless. =item $TB->maybe_regex diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index 11d4ff7..22c8c59 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -8,7 +8,7 @@ use Test::Builder 0.99; require Exporter; our @ISA = qw(Exporter); -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index 0cd7d23..7edfe54 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.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Stream 1.301001 '-internal'; diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm index 04cd6af..84df56e 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.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Stream 1.301001 '-internal'; diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index 8b55adf..70124d9 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -4,7 +4,7 @@ use 5.008001; use strict; use warnings; -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Stream 1.301001 '-internal'; diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index 27ba03e..9f3b2a2 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -5,10 +5,10 @@ use 5.008001; use strict; use warnings; -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) -use Test::Stream 1.301001_084 '-internal'; +use Test::Stream 1.301001_087 '-internal'; use Test::Stream::Toolset; use Test::Stream::Exporter; diff --git a/cpan/Test-Simple/lib/Test/Stream.pm b/cpan/Test-Simple/lib/Test/Stream.pm index 705e0c3..762fcaa 100644 --- a/cpan/Test-Simple/lib/Test/Stream.pm +++ b/cpan/Test-Simple/lib/Test/Stream.pm @@ -2,7 +2,7 @@ package Test::Stream; use strict; use warnings; -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Stream::Context qw/context/; diff --git a/cpan/Test-Simple/lib/Test/Stream/Util.pm b/cpan/Test-Simple/lib/Test/Stream/Util.pm index 0ba9354..60325a3 100644 --- a/cpan/Test-Simple/lib/Test/Stream/Util.pm +++ b/cpan/Test-Simple/lib/Test/Stream/Util.pm @@ -14,7 +14,21 @@ exports qw{ Test::Stream::Exporter->cleanup(); -sub protect(&) { +sub _manual_protect(&) { + my $code = shift; + + my ($ok, $error); + { + my ($msg, $no) = ($@, $!); + $ok = eval { $code->(); 1 } || 0; + $error = $@ || "Error was squashed!\n"; + ($@, $!) = ($msg, $no); + } + die $error unless $ok; + return $ok; +} + +sub _local_protect(&) { my $code = shift; my ($ok, $error); @@ -27,7 +41,28 @@ sub protect(&) { return $ok; } -sub try(&) { +sub _manual_try(&) { + my $code = shift; + my $error; + my $ok; + + { + my ($msg, $no) = ($@, $!); + my $die = delete $SIG{__DIE__}; + + $ok = eval { $code->(); 1 } || 0; + unless($ok) { + $error = $@ || "Error was squashed!\n"; + } + + ($@, $!) = ($msg, $no); + $SIG{__DIE__} = $die; + } + + return wantarray ? ($ok, $error) : $ok; +} + +sub _local_try(&) { my $code = shift; my $error; my $ok; @@ -43,6 +78,18 @@ sub try(&) { return wantarray ? ($ok, $error) : $ok; } +BEGIN { + if ($^O eq 'MSWin32' && $] < 5.020002) { + *protect = \&_manual_protect; + *try = \&_manual_try; + } + else { + *protect = \&_local_protect; + *try = \&_local_try; + } +} + + sub spoof { my ($call, $code, @args) = @_; @@ -55,8 +102,7 @@ sub spoof { my $error; my $ok; - { - local ($@, $!); + protect { $ok = eval <<" EOT" || 0; package $call->[0]; #line $call->[2] "$call->[1]" @@ -66,7 +112,7 @@ $code; unless($ok) { $error = $@ || "Error was squashed!\n"; } - } + }; return wantarray ? ($ok, $error) : $ok; } diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm index e758a50..dc0dbd3 100644 --- a/cpan/Test-Simple/lib/Test/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Tester.pm @@ -16,7 +16,7 @@ require Exporter; use vars qw( @ISA @EXPORT $VERSION ); -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) @EXPORT = qw( run_tests check_tests check_test cmp_results show_space ); diff --git a/cpan/Test-Simple/lib/Test/use/ok.pm b/cpan/Test-Simple/lib/Test/use/ok.pm index 18d1026..e4f037c 100644 --- a/cpan/Test-Simple/lib/Test/use/ok.pm +++ b/cpan/Test-Simple/lib/Test/use/ok.pm @@ -3,7 +3,7 @@ use strict; use warnings; use 5.005; -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Stream 1.301001 '-internal'; diff --git a/cpan/Test-Simple/lib/ok.pm b/cpan/Test-Simple/lib/ok.pm index f7fa459..7ab7abc 100644 --- a/cpan/Test-Simple/lib/ok.pm +++ b/cpan/Test-Simple/lib/ok.pm @@ -6,7 +6,7 @@ use Test::Stream 1.301001 '-internal'; use Test::More 1.301001 (); use Test::Stream::Carp qw/croak/; -our $VERSION = '1.301001_084'; +our $VERSION = '1.301001_087'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) sub import { diff --git a/cpan/Test-Simple/t/Legacy/fork_die.t b/cpan/Test-Simple/t/Legacy/fork_die.t index 6728e28..31fb9b6 100644 --- a/cpan/Test-Simple/t/Legacy/fork_die.t +++ b/cpan/Test-Simple/t/Legacy/fork_die.t @@ -1,14 +1,6 @@ use strict; use warnings; -BEGIN { - if ($^O eq 'MSWin32' || $^O eq 'NetWare') { - require Test::More; - Test::More::plan(skip_all => "This test is unreliable on $^O, also not likely to be helpful"); - exit 0; - } -} - use Test::CanFork; # The failure case for this test is producing 2 results, 1 pass and 1 fail, @@ -46,6 +38,7 @@ subtest do_it => sub { waitpid($pid, 0); ok($?, "Process exited with failure"); + my $file = __FILE__; { local $SIG{ALRM} = sub { die "Read Timeout\n" }; alarm 2; @@ -56,7 +49,7 @@ subtest do_it => sub { [ "Subtest finished with a new PID ($pid vs $$) while forking support was turned off!", 'This is almost certainly not what you wanted. Did you fork and forget to exit?', - "This process did something wrong! at t/Legacy/fork_die.t line $line.", + "This process did something wrong! at $file line $line.", ], "Got warning and exception, nothing else" ); diff --git a/cpan/Test-Simple/t/Legacy/subtest/fork.t b/cpan/Test-Simple/t/Legacy/subtest/fork.t index 7e0c685..ae1b038 100644 --- a/cpan/Test-Simple/t/Legacy/subtest/fork.t +++ b/cpan/Test-Simple/t/Legacy/subtest/fork.t @@ -6,21 +6,14 @@ use Test::CanFork; use IO::Pipe; use Test::Builder; -use Test::More tests => 1; - -# On systems that fake forking, localized vars get unwound improperly -# post-fork. the 'subtest' function localizes $@ and $!, as such this -# test will fail on fake-fork systems up until 5.20.2 -plan skip_all => "Skipping fork tests on $^O" - if ($^O eq 'MSWin32' || $^O eq 'NetWare') - && !eval { require v5.20.2 }; +use Test::More; subtest 'fork within subtest' => sub { - plan tests => 2; - my $pipe = IO::Pipe->new; - my $pid = fork; - defined $pid or plan skip_all => "Fork not working"; + + my $pid = fork(); + plan skip_all => "Fork not working" + unless defined $pid; if ($pid) { $pipe->reader; @@ -45,3 +38,4 @@ subtest 'fork within subtest' => sub { } }; +done_testing; diff --git a/cpan/Test-Simple/t/Test-Stream-API.t b/cpan/Test-Simple/t/Test-Stream-API.t index 688d9d4..7ad57ee 100644 --- a/cpan/Test-Simple/t/Test-Stream-API.t +++ b/cpan/Test-Simple/t/Test-Stream-API.t @@ -101,13 +101,6 @@ isa_ok($follow[0], 'Test::Stream::Context'); my $events = intercept { Test::CanFork->import; - # On systems that fake forking, localized vars get unwound improperly - # post-fork. the 'intercept' function localizes $@ and $!, as such this - # test will fail on fake-fork systems up until 5.20.2 - plan skip_all => "Skipping fork tests on $^O" - if ($^O eq 'MSWin32' || $^O eq 'NetWare') - && !eval { require v5.20.2 }; - enable_forking; my $pid = fork(); -- Perl5 Master Repository
