Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

perl blead: Update Test-Simple to alpha 076 [PATCH] #14265

Closed
p5pRT opened this issue Nov 22, 2014 · 20 comments
Closed

perl blead: Update Test-Simple to alpha 076 [PATCH] #14265

p5pRT opened this issue Nov 22, 2014 · 20 comments
Labels
hasPatch

Comments

@p5pRT
Copy link

p5pRT commented Nov 22, 2014

Migrated from rt.perl.org#123277 (status was 'resolved')

Searchable as RT123277$
@p5pRT
Copy link
Author

p5pRT commented Nov 22, 2014

From @exodist

Attached is a patch to bring Test-Simple up to alpha 076 in blead.

This fixes a couple downstream modules such as Test​::WWW​::Mechanize.

-Chad

@p5pRT
Copy link
Author

p5pRT commented Nov 22, 2014

From @exodist

0001-Update-Test-Simple-to-alpha-076.patch 
From 209b24caeb915e86939f6828d72b832033364570 Mon Sep 17 00:00:00 2001
From: Chad Granum <chad.granum@dreamhost.com>
Date: Sat, 22 Nov 2014 11:58:05 -0800
Subject: [PATCH] Update Test-Simple to alpha 076

---
 MANIFEST                                          |  1 +
 cpan/Test-Simple/lib/Test/Builder.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/More.pm                 |  2 +-
 cpan/Test-Simple/lib/Test/More/Tools.pm           | 15 +++++
 cpan/Test-Simple/lib/Test/Simple.pm               |  4 +-
 cpan/Test-Simple/lib/Test/Stream.pm               |  2 +-
 cpan/Test-Simple/lib/Test/Stream/Context.pm       | 13 ++--
 cpan/Test-Simple/lib/Test/Stream/IOSets.pm        |  2 +-
 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              | 79 +++++++++++++++++++++++
 15 files changed, 116 insertions(+), 16 deletions(-)
 create mode 100644 cpan/Test-Simple/t/Legacy/fork_die.t

diff --git a/MANIFEST b/MANIFEST
index d1b2c7c..bd4a00a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2371,6 +2371,7 @@ cpan/Test-Simple/t/Legacy/fail-more.t			Test::Simple Test
 cpan/Test-Simple/t/Legacy/fail_one.t			Test::Simple Test
 cpan/Test-Simple/t/Legacy/fail.t			Test::Simple Test
 cpan/Test-Simple/t/Legacy/filehandles.t			Test::Simple Test
+cpan/Test-Simple/t/Legacy/fork_die.t			Test::Simple Test
 cpan/Test-Simple/t/Legacy/fork_in_subtest.t			Test::Simple Test
 cpan/Test-Simple/t/Legacy/fork.t			Test::Simple Test
 cpan/Test-Simple/t/Legacy/harness_active.t			Test::Simple Test
diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm
index 1a28d72..aa9a417 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_075';
+our $VERSION = '1.301001_076';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 
diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm
index 2ad2454..79340ed 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_075';
+our $VERSION = '1.301001_076';
 $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 28c0113..dfdfc5e 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_075';
+our $VERSION = '1.301001_076';
 $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 e8dfa85..6498c6a 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_075';
+our $VERSION = '1.301001_076';
 $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 fcbf4c5..d1b7e65 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_075';
+our $VERSION = '1.301001_076';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream 1.301001 '-internal';
diff --git a/cpan/Test-Simple/lib/Test/More/Tools.pm b/cpan/Test-Simple/lib/Test/More/Tools.pm
index 7357f35..98027cc 100644
--- a/cpan/Test-Simple/lib/Test/More/Tools.pm
+++ b/cpan/Test-Simple/lib/Test/More/Tools.pm
@@ -334,6 +334,8 @@ sub subtest {
     $ctx->clear;
     my $todo = $ctx->hide_todo;
 
+    my $pid = $$;
+
     my ($succ, $err) = try {
         {
             no warnings 'once';
@@ -352,6 +354,19 @@ sub subtest {
         }
     };
 
+    if ($$ != $pid && !$ctx->stream->_use_fork) {
+        warn <<"        EOT";
+Subtest finished with a new PID ($$ vs $pid) while forking support was turned off!
+This is almost certainly not what you wanted. Did you fork and forget to exit?
+        EOT
+
+        # Did the forked process try to exit via die?
+        die $err unless $succ;
+    }
+
+    # If a subtest forked, then threw an exception, we need to propogate that right away.
+    die $err unless $succ || $$ == $pid || $err->isa('Test::Stream::Event');
+
     $ctx->set;
     $ctx->restore_todo($todo);
     # This sends the subtest event
diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm
index c5e6808..297c490 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_075';
+our $VERSION = '1.301001_076';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-use Test::Stream 1.301001_075 '-internal';
+use Test::Stream 1.301001_076 '-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 789544d..6decda3 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_075';
+our $VERSION = '1.301001_076';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream::Context qw/context/;
diff --git a/cpan/Test-Simple/lib/Test/Stream/Context.pm b/cpan/Test-Simple/lib/Test/Stream/Context.pm
index 5b17d42..51b89e2 100644
--- a/cpan/Test-Simple/lib/Test/Stream/Context.pm
+++ b/cpan/Test-Simple/lib/Test/Stream/Context.pm
@@ -164,10 +164,15 @@ sub _find_context {
     my $level = 2 + $add + $tb;
     my ($package, $file, $line, $subname) = caller($level);
 
-    return unless $package;
-
-    while ($package eq 'Test::Builder') {
-        ($package, $file, $line, $subname) = caller(++$level);
+    if ($package) {
+        while ($package eq 'Test::Builder') {
+            ($package, $file, $line, $subname) = caller(++$level);
+        }
+    }
+    else {
+        while (!$package) {
+            ($package, $file, $line, $subname) = caller(--$level);
+        }
     }
 
     return unless $package;
diff --git a/cpan/Test-Simple/lib/Test/Stream/IOSets.pm b/cpan/Test-Simple/lib/Test/Stream/IOSets.pm
index ae86277..e2352ef 100644
--- a/cpan/Test-Simple/lib/Test/Stream/IOSets.pm
+++ b/cpan/Test-Simple/lib/Test/Stream/IOSets.pm
@@ -79,7 +79,7 @@ sub _copy_io_layers {
 }
 
 sub _autoflush {
-    my($fh) = shift;
+    my($fh) = pop;
     my $old_fh = select $fh;
     $| = 1;
     select $old_fh;
diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm
index c0a5cd9..48e6c7d 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_075';
+our $VERSION = '1.301001_076';
 $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 7e041dc..b1ac438 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_075';
+our $VERSION = '1.301001_076';
 $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 b6b51e4..18c6d2c 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_075';
+our $VERSION = '1.301001_076';
 $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
new file mode 100644
index 0000000..d649e1a
--- /dev/null
+++ b/cpan/Test-Simple/t/Legacy/fork_die.t
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+use Config;
+
+BEGIN {
+    my $Can_Fork = $Config{d_fork} ||
+                   (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+                    $Config{useithreads} and
+                    $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+                   );
+
+    if( !$Can_Fork ) {
+        require Test::More;
+        Test::More::plan(skip_all => "This system cannot fork");
+        exit 0;
+    }
+    elsif ($^O eq 'MSWin32' && $] == 5.010000) {
+        require Test::More;
+        Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
+        exit 0;
+    }
+}
+
+# The failure case for this test is producing 2 results, 1 pass and 1 fail,
+# both with the same test number. If this test file does anything other than 1
+# (non-indented) result that passes, it has failed in one way or another.
+use Test::More tests => 1;
+use Test::Stream qw/context/;
+
+my $line;
+
+subtest do_it => sub {
+    ok(1, "Pass!");
+
+    my ($read, $write);
+    pipe($read, $write) || die "Could not open pipe";
+
+    my $pid = fork();
+    die "Forking failed!" unless defined $pid;
+
+    unless($pid) {
+        close($read);
+        Test::Stream::IOSets->_autoflush($write);
+        my $ctx = context();
+        my $handles = $ctx->stream->io_sets->init_encoding('legacy');
+        $handles->[0] = $write;
+        $handles->[1] = $write;
+        $handles->[2] = $write;
+        *STDERR = $write;
+        *STDOUT = $write;
+
+        die "This process did something wrong!"; BEGIN { $line = __LINE__ };
+    }
+    close($write);
+
+    waitpid($pid, 0);
+    ok($?, "Process exited with failure");
+
+    {
+        local $SIG{ALRM} = sub { die "Read Timeout\n" };
+        alarm 2;
+        my @output = map {chomp($_); $_} <$read>;
+        alarm 0;
+        is_deeply(
+            \@output,
+            [
+                "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.",
+            ],
+            "Got warning and exception, nothing else"
+       );
+    }
+
+    ok(1, "Pass After!");
+};
+
+done_testing;
-- 
1.9.1

@p5pRT
Copy link
Author

p5pRT commented Nov 22, 2014

From @jkeenan

On Sat Nov 22 13​:07​:46 2014, exodist7@​gmail.com wrote​:

Attached is a patch to bring Test-Simple up to alpha 076 in blead.

This fixes a couple downstream modules such as Test​::WWW​::Mechanize.

-Chad

Pushed to blead in commit 136323e

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Nov 22, 2014

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Nov 22, 2014

@jkeenan - Status changed from 'open' to 'resolved'

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @jkeenan

Chad​: We're getting one test failure from this patch set on our Win32 smoke test server​:

../cpan/Test-Simple/t/Legacy/fork_die.t (Wstat​: 65280 Tests​: 0 Failed​: 0)
  Non-zero exit status​: 255
  Parse errors​: Bad plan. You planned 1 tests but ran 0.

See​: http​://perl5.git.perl.org​:8080/job/perl5-win32/560/console

Can you investigate?

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

@jkeenan - Status changed from 'resolved' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @exodist

I will try to get a follow-up patch this evening to address the issue. If
someone wants to simply remove the test for now I will re-add it in my
follow up. It is a non critical failure, a bug in the test, not the module.

On Sat, Nov 22, 2014, 7​:15 PM James E Keenan via RT <
perlbug-followup@​perl.org> wrote​:

Chad​: We're getting one test failure from this patch set on our Win32
smoke test server​:

../cpan/Test-Simple/t/Legacy/fork_die.t (Wstat​:
65280 Tests​: 0 Failed​: 0)
Non-zero exit status​: 255
Parse errors​: Bad plan. You planned 1 tests but ran 0.

See​: http​://perl5.git.perl.org​:8080/job/perl5-win32/560/console

Can you investigate?

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @bulk88

On Sat Nov 22 19​:15​:10 2014, jkeenan wrote​:

Chad​: We're getting one test failure from this patch set on our Win32
smoke test server​:

../cpan/Test-Simple/t/Legacy/fork_die.t
(Wstat​: 65280 Tests​: 0 Failed​: 0)
Non-zero exit status​: 255
Parse errors​: Bad plan. You planned 1 tests but ran 0.

See​: http​://perl5.git.perl.org​:8080/job/perl5-win32/560/console

Can you investigate?

Thank you very much.

SEGV. This is -O1 VC Perl.

First-chance exception at 0x2808c813 (perl521.dll) in perl.exe​: 0xC0000005​: Access violation writing location 0x00000000.

  perl521.dll!Perl_sv_setpvn(interpreter * my_perl=0x00c4abdc, sv * const sv=0x00e1169c, const char * const ptr=0x280f4583, const unsigned int len=0) Line 4922 C
  perl521.dll!Perl_create_eval_scope(interpreter * my_perl=0x00c4abdc, unsigned long flags=269) Line 4380 + 0x6b C
  perl521.dll!Perl_call_sv(interpreter * my_perl=0x280c5f3b, sv * sv=0x00cc59f4, volatile long flags=17759824) Line 2724 C
  perl521.dll!Perl_call_list(interpreter * my_perl=0x00c4abdc, long oldscope=1, av * paramList=0x00e1136c) Line 4841 C
  perl521.dll!win32_start_child(void * arg=0x00c4abdc) Line 1796 + 0xb C
  kernel32.dll!_BaseThreadStart@​8() + 0x37

  SvUPGRADE(sv, SVt_PV);

  dptr = SvGROW(sv, len + 1);
  Move(ptr,dptr,len,char);
  dptr[len] = '\0';<<<<<<<<<<<<<<<<<<<<<<<<<<CRASH
  SvCUR_set(sv, len);
  (void)SvPOK_only_UTF8(sv); /* validate pointer */
  SvTAINT(sv);
  if (SvTYPE(sv) == SVt_PVCV) CvAUTOLOAD_off(sv);
}

in Perl_create_eval_scope execution is at

Perl_create_eval_scope(pTHX_ U32 flags)
{
  PERL_CONTEXT *cx;
  const I32 gimme = GIMME_V;
 
  ENTER_with_name("eval_scope");
  SAVETMPS;

  PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
  PUSHEVAL(cx, 0);

  PL_in_eval = EVAL_INEVAL;
  if (flags & G_KEEPERR)
  PL_in_eval |= EVAL_KEEPERR;
  else
  CLEAR_ERRSV();<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  if (flags & G_FAKINGEVAL) {
  PL_eval_root = PL_op; /* Only needed so that goto works right. */
  }
  return cx;
}

Other thread at crash point

  ntdll.dll!_KiFastSystemCallRet@​0()
  ntdll.dll!_ZwWaitForMultipleObjects@​20() + 0xc
  kernel32.dll!_WaitForMultipleObjectsEx@​20() - 0x48
  user32.dll!_RealMsgWaitForMultipleObjectsEx@​20() + 0xd9
  user32.dll!_MsgWaitForMultipleObjects@​20() + 0x1f
  perl521.dll!win32_msgwait(interpreter * my_perl=0x00365fe4, unsigned long count=1, void * * handles=0x0012fc74, unsigned long timeout=4294967295, unsigned long * resultp=0x0012fc7c) Line 2242 C
  perl521.dll!win32_waitpid(int pid=1924, int * status=0x0012fcb0, int flags=1) Line 2350 + 0x13 C
  perl521.dll!Perl_wait4pid(interpreter * my_perl=0x7ffd4000, int pid=-7256, int * statusp=0x0012fcb0, int flags=0) Line 2998 + 0x13 C
  perl521.dll!Perl_pp_waitpid(interpreter * my_perl=0x00000000) Line 4203 + 0x32 C
  perl521.dll!Perl_runops_standard(interpreter * my_perl=0x00365fe4) Line 41 + 0x4 C
  perl521.dll!S_run_body(interpreter * my_perl=0x7ffd4000, long oldscope=1) Line 2420 + 0xa C
  perl521.dll!perl_run(interpreter * my_perl=0x00365fe4) Line 2343 + 0x8 C
  perl521.dll!RunPerl(int argc=4, char * * argv=0x01363f70, char * * env=0x00363090) Line 258 + 0x6 C
  perl.exe!mainCRTStartup() Line 398 + 0xe C
  kernel32.dll!_BaseProcessStart@​4() + 0x23

In crashed thread curcop is

sub subtest {
  my ($class, $name, $code, @​args) = @​_;

  my $ctx = context();

  $ctx->throw("subtest()'s second argument must be a code ref")
  unless $code && 'CODE' eq reftype($code);

  $ctx->child('push', $name);
  $ctx->clear;
  my $todo = $ctx->hide_todo;

  my $pid = $$;

  my ($succ, $err) = try {
  {
  no warnings 'once';
  local $Test​::Builder​::Level = 1;
  $code->(@​args);
  }

  $ctx->set;
  my $stream = $ctx->stream;
  $ctx->done_testing unless $stream->plan || $stream->ended;

  require Test​::Stream​::ExitMagic;
  {
  local $? = 0;
  Test​::Stream​::ExitMagic->new->do_magic($stream, $ctx->snapshot);
  }
  };

  if ($$ != $pid && !$ctx->stream->_use_fork) {
  warn <<" EOT";
Subtest finished with a new PID ($$ vs $pid) while forking support was turned off!
This is almost certainly not what you wanted. Did you fork and forget to exit?
  EOT

  # Did the forked process try to exit via die?
  die $err unless $succ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  }

  # If a subtest forked, then threw an exception, we need to propogate that right away.
  die $err unless $succ || $$ == $pid || $err->isa('Test​::Stream​::Event');

  $ctx->set;
  $ctx->restore_todo($todo);
  # This sends the subtest event
  my $st = $ctx->child('pop', $name);

  unless ($succ) {
  die $err unless blessed($err) && $err->isa('Test​::Stream​::Event');
  $ctx->bail($err->reason) if $err->isa('Test​::Stream​::Event​::Bail');
  }

  return $st->bool;
}

The SV in question is freed see attached.

The highlighted line, even tho its probably uninit/misused memory, had the following interesting string pointer in it.

+ xpv_len_u {xpvlenu_len=14859588 xpvlenu_pv=0x00e2bd44 "This process did something wrong! at t/Legacy/fork_die.t line 53.
" } xpvmg​::__unnamed

the SV in the GV in PL_errsv is also free and is the one in 1st pic

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @bulk88

PL_errgv_is_freed.PNG

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @bulk88

[sv dump.PNG](https://rt-archive.perl.org/perl5/Ticket/Attachment/1319813/702907/sv dump.PNG)

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @exodist

I was pretty sure this test could not pass on windows, even though I do not
have a windows system handy to test (Not home right now). There are a
couple such tests in Test-Simple like this that simply skip on systems
without a real fork. I will make this test skip on such systems just like
the others do.

I intend to release the following once I have done my own testing​:
Test-More/test-more@eb36b87

It will be part of the patch I will submit to this thread. I just need to
do my testing first, which takes an hour or so. I need to build blead on
this system (linux). I also need to run my downstream tests that build half
of cpan against the new Test​::Simple version.

However if the issue highlighted is actually a bug in perl itself, I have
no objections to having it fixed :-).

-Chad

On Sat Nov 22 2014 at 7​:50​:08 PM bulk88 via RT <perlbug-followup@​perl.org>
wrote​:

On Sat Nov 22 19​:15​:10 2014, jkeenan wrote​:

Chad​: We're getting one test failure from this patch set on our Win32
smoke test server​:

../cpan/Test-Simple/t/Legacy/fork_die.t
(Wstat​: 65280 Tests​: 0 Failed​: 0)
Non-zero exit status​: 255
Parse errors​: Bad plan. You planned 1 tests but ran 0.

See​: http​://perl5.git.perl.org​:8080/job/perl5-win32/560/console

Can you investigate?

Thank you very much.

SEGV. This is -O1 VC Perl.

First-chance exception at 0x2808c813 (perl521.dll) in perl.exe​:
0xC0000005​: Access violation writing location 0x00000000.

    perl521\.dll\!Perl\_sv\_setpvn\(interpreter \* my\_perl=0x00c4abdc\, sv \*

const sv=0x00e1169c, const char * const ptr=0x280f4583, const unsigned int
len=0) Line 4922 C
perl521.dll!Perl_create_eval_scope(interpreter *
my_perl=0x00c4abdc, unsigned long flags=269) Line 4380 + 0x6b C
perl521.dll!Perl_call_sv(interpreter * my_perl=0x280c5f3b, sv *
sv=0x00cc59f4, volatile long flags=17759824) Line 2724 C
perl521.dll!Perl_call_list(interpreter * my_perl=0x00c4abdc, long
oldscope=1, av * paramList=0x00e1136c) Line 4841 C
perl521.dll!win32_start_child(void * arg=0x00c4abdc) Line 1796 +
0xb C
kernel32.dll!_BaseThreadStart@​8() + 0x37

SvUPGRADE\(sv\, SVt\_PV\);

dptr = SvGROW\(sv\, len \+ 1\);
Move\(ptr\,dptr\,len\,char\);
dptr\[len\] = '\\0';\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<CRASH
SvCUR\_set\(sv\, len\);
\(void\)SvPOK\_only\_UTF8\(sv\);          /\* validate pointer \*/
SvTAINT\(sv\);
if \(SvTYPE\(sv\) == SVt\_PVCV\) CvAUTOLOAD\_off\(sv\);

}

in Perl_create_eval_scope execution is at

Perl_create_eval_scope(pTHX_ U32 flags)
{
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;

ENTER\_with\_name\("eval\_scope"\);
SAVETMPS;

PUSHBLOCK\(cx\, \(CXt\_EVAL|CXp\_TRYBLOCK\)\, PL\_stack\_sp\);
PUSHEVAL\(cx\, 0\);

PL\_in\_eval = EVAL\_INEVAL;
if \(flags & G\_KEEPERR\)
    PL\_in\_eval |= EVAL\_KEEPERR;
else
    CLEAR\_ERRSV\(\);\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<
if \(flags & G\_FAKINGEVAL\) \{
    PL\_eval\_root = PL\_op; /\* Only needed so that goto works right\. \*/
\}
return cx;

}

Other thread at crash point

    ntdll\.dll\!\_KiFastSystemCallRet@&#8203;0\(\)
    ntdll\.dll\!\_ZwWaitForMultipleObjects@&#8203;20\(\)  \+ 0xc
    kernel32\.dll\!\_WaitForMultipleObjectsEx@&#8203;20\(\)  \- 0x48
    user32\.dll\!\_RealMsgWaitForMultipleObjectsEx@&#8203;20\(\)  \+ 0xd9
    user32\.dll\!\_MsgWaitForMultipleObjects@&#8203;20\(\)  \+ 0x1f
    perl521\.dll\!win32\_msgwait\(interpreter \* my\_perl=0x00365fe4\,

unsigned long count=1, void * * handles=0x0012fc74, unsigned long
timeout=4294967295, unsigned long * resultp=0x0012fc7c) Line 2242 C
perl521.dll!win32_waitpid(int pid=1924, int * status=0x0012fcb0,
int flags=1) Line 2350 + 0x13 C
perl521.dll!Perl_wait4pid(interpreter * my_perl=0x7ffd4000, int
pid=-7256, int * statusp=0x0012fcb0, int flags=0) Line 2998 + 0x13 C
perl521.dll!Perl_pp_waitpid(interpreter * my_perl=0x00000000)
Line 4203 + 0x32 C
perl521.dll!Perl_runops_standard(interpreter *
my_perl=0x00365fe4) Line 41 + 0x4 C
perl521.dll!S_run_body(interpreter * my_perl=0x7ffd4000, long
oldscope=1) Line 2420 + 0xa C
perl521.dll!perl_run(interpreter * my_perl=0x00365fe4) Line 2343
+ 0x8 C
perl521.dll!RunPerl(int argc=4, char * * argv=0x01363f70, char * *
env=0x00363090) Line 258 + 0x6 C
perl.exe!mainCRTStartup() Line 398 + 0xe C
kernel32.dll!_BaseProcessStart@​4() + 0x23

In crashed thread curcop is

sub subtest {
my ($class, $name, $code, @​args) = @​_;

my $ctx = context\(\);

$ctx\->throw\("subtest\(\)'s second argument must be a code ref"\)
    unless $code && 'CODE' eq reftype\($code\);

$ctx\->child\('push'\, $name\);
$ctx\->clear;
my $todo = $ctx\->hide\_todo;

my $pid = $$;

my \($succ\, $err\) = try \{
    \{
        no warnings 'once';
        local $Test&#8203;::Builder&#8203;::Level = 1;
        $code\->\(@&#8203;args\);
    \}

    $ctx\->set;
    my $stream = $ctx\->stream;
    $ctx\->done\_testing unless $stream\->plan || $stream\->ended;

    require Test&#8203;::Stream&#8203;::ExitMagic;
    \{
        local $? = 0;
        Test&#8203;::Stream&#8203;::ExitMagic\->new\->do\_magic\($stream\,

$ctx->snapshot);
}
};

if \($$ \!= $pid && \!$ctx\->stream\->\_use\_fork\) \{
    warn \<\<"        EOT";

Subtest finished with a new PID ($$ vs $pid) while forking support was
turned off!
This is almost certainly not what you wanted. Did you fork and forget to
exit?
EOT

    \# Did the forked process try to exit via die?
    die $err unless $succ;\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<\<

<<<<<<<<<<<<<<<<<<<<<<<<<<<
}

\# If a subtest forked\, then threw an exception\, we need to propogate

that right away.
die $err unless $succ || $$ == $pid || $err->isa('Test​::Stream​::
Event');

$ctx\->set;
$ctx\->restore\_todo\($todo\);
\# This sends the subtest event
my $st = $ctx\->child\('pop'\, $name\);

unless \($succ\) \{
    die $err unless blessed\($err\) && $err\->isa\('Test&#8203;::Stream&#8203;::Event'\);
    $ctx\->bail\($err\->reason\) if $err\->isa\('Test&#8203;::Stream&#8203;::

Event​::Bail');
}

return $st\->bool;

}

The SV in question is freed see attached.

The highlighted line, even tho its probably uninit/misused memory, had the
following interesting string pointer in it.

+ xpv_len_u {xpvlenu_len=14859588 xpvlenu_pv=0x00e2bd44 "This
process did something wrong! at t/Legacy/fork_die.t line 53.
" } xpvmg​::__unnamed

the SV in the GV in PL_errsv is also free and is the one in 1st pic

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @exodist

This patch *should* fix the window issue, and brings blead up to alpha 077. I do not have a windows system available, so I will rely on someone else to verify it in windows. I have verified it on my system, and all my downstream checks also passed (linux only).

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @exodist

0001-Update-Test-Simple-to-alpha-077.patch 
From 09fbf143234bc310ecfde212bba28c6597e576bf Mon Sep 17 00:00:00 2001
From: Chad Granum <chad.granum@dreamhost.com>
Date: Sat, 22 Nov 2014 19:59:44 -0800
Subject: [PATCH] Update Test-Simple to alpha 077

---
 MANIFEST                                           |   4 +
 cpan/Test-Simple/lib/Test/Builder.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/CanFork.pm               |  94 +++++++++++++++++++
 cpan/Test-Simple/lib/Test/CanThread.pm             | 103 +++++++++++++++++++++
 cpan/Test-Simple/lib/Test/More.pm                  |   2 +-
 cpan/Test-Simple/lib/Test/More/Tools.pm            |   6 +-
 cpan/Test-Simple/lib/Test/Simple.pm                |   4 +-
 cpan/Test-Simple/lib/Test/Stream.pm                |   8 +-
 cpan/Test-Simple/lib/Test/Stream/ForceExit.pm      |  97 +++++++++++++++++++
 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/Behavior/388-threadedsubtest.t  |  26 +-----
 cpan/Test-Simple/t/Behavior/fork_new_end.t         |  25 +----
 .../t/Behavior/threads_with_taint_mode.t           |  41 +++-----
 .../t/Legacy/Builder/fork_with_new_stdout.t        |  20 +---
 cpan/Test-Simple/t/Legacy/fork.t                   |  19 +---
 cpan/Test-Simple/t/Legacy/fork_die.t               |  19 +---
 cpan/Test-Simple/t/Legacy/fork_in_subtest.t        |  21 +----
 cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t |  23 +----
 cpan/Test-Simple/t/Legacy/ribasushi_threads.t      |  35 +------
 cpan/Test-Simple/t/Legacy/ribasushi_threads2.t     |  32 +------
 cpan/Test-Simple/t/Legacy/subtest/basic.t          |   4 +-
 cpan/Test-Simple/t/Legacy/subtest/fork.t           |  22 +----
 cpan/Test-Simple/t/Legacy/subtest/threads.t        |  10 +-
 cpan/Test-Simple/t/Legacy/threads.t                |  24 +----
 cpan/Test-Simple/t/Test-Stream-ForceExit.t         |  69 ++++++++++++++
 30 files changed, 422 insertions(+), 300 deletions(-)
 create mode 100644 cpan/Test-Simple/lib/Test/CanFork.pm
 create mode 100644 cpan/Test-Simple/lib/Test/CanThread.pm
 create mode 100644 cpan/Test-Simple/lib/Test/Stream/ForceExit.pm
 create mode 100644 cpan/Test-Simple/t/Test-Stream-ForceExit.t

diff --git a/MANIFEST b/MANIFEST
index bd4a00a..f5126e0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2259,6 +2259,8 @@ cpan/Test-Simple/lib/Test/Builder/Module.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Builder.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Builder/Tester.pm			Test::Simple module
+cpan/Test-Simple/lib/Test/CanFork.pm			Test::Simple module
+cpan/Test-Simple/lib/Test/CanThread.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/FAQ.pod			Test::Simple module
 cpan/Test-Simple/lib/Test/More/DeepCheck.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/More/DeepCheck/Strict.pm			Test::Simple module
@@ -2285,6 +2287,7 @@ cpan/Test-Simple/lib/Test/Stream/ExitMagic/Context.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/ExitMagic.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/Exporter/Meta.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/Exporter.pm			Test::Simple module
+cpan/Test-Simple/lib/Test/Stream/ForceExit.pm			Test-Simple module
 cpan/Test-Simple/lib/Test/Stream/IOSets.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/Meta.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm			Test::Simple module
@@ -2486,6 +2489,7 @@ cpan/Test-Simple/t/Test-Stream-Event.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-ExitMagic-Context.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-Exporter-Meta.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-Exporter.t			Test::Simple Test
+cpan/Test-Simple/t/Test-Stream-ForceExit.t			Test-Simple test
 cpan/Test-Simple/t/Test-Stream-IOSets.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-Meta.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-PackageUtil.t			Test::Simple Test
diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm
index aa9a417..b31ee9f 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_076';
+our $VERSION = '1.301001_077';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 
diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm
index 79340ed..f279595 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_076';
+our $VERSION = '1.301001_077';
 $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 dfdfc5e..d93bd7e 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_076';
+our $VERSION = '1.301001_077';
 $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 6498c6a..1892b7c 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_076';
+our $VERSION = '1.301001_077';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream 1.301001 '-internal';
diff --git a/cpan/Test-Simple/lib/Test/CanFork.pm b/cpan/Test-Simple/lib/Test/CanFork.pm
new file mode 100644
index 0000000..b28a382
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/CanFork.pm
@@ -0,0 +1,94 @@
+package Test::CanFork;
+use strict;
+use warnings;
+
+use Config;
+
+my $Can_Fork = $Config{d_fork}
+    || (($^O eq 'MSWin32' || $^O eq 'NetWare')
+    and $Config{useithreads}
+    and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
+
+if (!$Can_Fork) {
+    require Test::More;
+    Test::More::plan(skip_all => "This system cannot fork");
+    exit 0;
+}
+
+if ($^O eq 'MSWin32' && $] == 5.010000) {
+    require Test::More;
+    Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
+    exit 0;
+}
+
+sub import {
+    my $class = shift;
+    for my $var (@_) {
+        next if $ENV{$var};
+
+        require Test::More;
+        Test::More::plan(skip_all => "This forking test will only run when the '$var' environment variable is set.");
+        exit 0;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::CanFork - Only run tests when forking is supported, optionally conditioned on ENV vars.
+
+=head1 DESCRIPTION
+
+Use this first thing in a test that should be skipped when forking is not
+supported. You can also specify that the test should be skipped when specific
+environment variables are not set.
+
+=head1 SYNOPSYS
+
+Skip the test if forking is unsupported:
+
+    use Test::CanFork;
+    use Test::More;
+    ...
+
+Skip the test if forking is unsupported, or any of the specified env vars are
+not set:
+
+    use Test::CanFork qw/AUTHOR_TESTING RUN_PROBLEMATIC_TESTS .../;
+    use Test::More;
+    ...
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test/CanThread.pm b/cpan/Test-Simple/lib/Test/CanThread.pm
new file mode 100644
index 0000000..a9d6aeb
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/CanThread.pm
@@ -0,0 +1,103 @@
+package Test::CanThread;
+use strict;
+use warnings;
+
+use Config;
+
+if ($] == 5.010000) {
+    require Test::More;
+    Test::More::plan(skip_all => "Threads are broken on 5.10.0");
+    exit 0;
+}
+
+my $works = 1;
+$works &&= $] >= 5.008001;
+$works &&= $Config{'useithreads'};
+$works &&= eval { require threads; 'threads'->import; 1 };
+
+unless ($works) {
+    require Test::More;
+    Test::More::plan(skip_all => "Skip no working threads");
+    exit 0;
+}
+
+if ($INC{'Devel/Cover.pm'}) {
+    require Test::More;
+    Test::More::plan(skip_all => "Devel::Cover does not work with threads yet");
+    exit 0;
+}
+
+sub import {
+    my $class = shift;
+    while(my $var = shift(@_)) {
+        next if $ENV{$var};
+
+        require Test::More;
+        Test::More::plan(skip_all => "This threaded test will only run when the '$var' environment variable is set.");
+        exit 0;
+    }
+
+    unshift @_ => 'threads';
+    goto &threads::import;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::CanThread - Only run tests when threading is supported, optionally conditioned on ENV vars.
+
+=head1 DESCRIPTION
+
+Use this first thing in a test that should be skipped when threading is not
+supported. You can also specify that the test should be skipped when specific
+environment variables are not set.
+
+=head1 SYNOPSYS
+
+Skip the test if threading is unsupported:
+
+    use Test::CanThread;
+    use Test::More;
+    ...
+
+Skip the test if threading is unsupported, or any of the specified env vars are
+not set:
+
+    use Test::CanThread qw/AUTHOR_TESTING RUN_PROBLEMATIC_TESTS .../;
+    use Test::More;
+    ...
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm
index d1b7e65..c9ca5cd 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_076';
+our $VERSION = '1.301001_077';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream 1.301001 '-internal';
diff --git a/cpan/Test-Simple/lib/Test/More/Tools.pm b/cpan/Test-Simple/lib/Test/More/Tools.pm
index 98027cc..1360a8f 100644
--- a/cpan/Test-Simple/lib/Test/More/Tools.pm
+++ b/cpan/Test-Simple/lib/Test/More/Tools.pm
@@ -336,13 +336,17 @@ sub subtest {
 
     my $pid = $$;
 
+    my $early_return = 1;
     my ($succ, $err) = try {
-        {
+        TEST_STREAM_SUBTEST: {
             no warnings 'once';
             local $Test::Builder::Level = 1;
             $code->(@args);
+            $early_return = 0;
         }
 
+        die $ctx->stream->subtest_exception->[-1] if $early_return;
+
         $ctx->set;
         my $stream = $ctx->stream;
         $ctx->done_testing unless $stream->plan || $stream->ended;
diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm
index 297c490..23c3139 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_076';
+our $VERSION = '1.301001_077';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-use Test::Stream 1.301001_076 '-internal';
+use Test::Stream 1.301001_077 '-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 6decda3..15a3f48 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_076';
+our $VERSION = '1.301001_077';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream::Context qw/context/;
@@ -587,7 +587,9 @@ sub _finalize_event {
 
         $self->[SUBTEST_EXCEPTION]->[-1] = $e if $e->in_subtest;
 
-        die $e if $e->in_subtest || !$self->[EXIT_ON_DISRUPTION];
+        no warnings 'exiting';
+        last TEST_STREAM_SUBTEST if $e->in_subtest;
+        die $e unless $self->[EXIT_ON_DISRUPTION];
         exit 0;
     }
     elsif (!$cache->{do_tap} && $e->isa('Test::Stream::Event::Bail')) {
@@ -596,6 +598,8 @@ sub _finalize_event {
 
         $self->[SUBTEST_EXCEPTION]->[-1] = $e if $e->in_subtest;
 
+        no warnings 'exiting';
+        last TEST_STREAM_SUBTEST if $e->in_subtest;
         die $e if $e->in_subtest || !$self->[EXIT_ON_DISRUPTION];
         exit 255;
     }
diff --git a/cpan/Test-Simple/lib/Test/Stream/ForceExit.pm b/cpan/Test-Simple/lib/Test/Stream/ForceExit.pm
new file mode 100644
index 0000000..e32edfb
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/ForceExit.pm
@@ -0,0 +1,97 @@
+package Test::Stream::ForceExit;
+use strict;
+use warnings;
+
+sub new {
+    my $class = shift;
+
+    my $done = 0;
+    my $self = \$done;
+
+    return bless $self, $class;
+}
+
+sub done {
+    my $self = shift;
+    ($$self) = @_ if @_;
+    return $$self;
+}
+
+sub DESTROY {
+    my $self = shift;
+    return if $self->done;
+
+    warn "Something prevented child process $$ from exiting when it should have, Forcing exit now!\n";
+    $self->done(1); # Prevent duplicate message during global destruction
+    exit 255;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::ForceExit - Ensure C<exit()> is called bvy the end of a scope, force the issue.
+
+=head1 DESCRIPTION
+
+Sometimes you need to fork. Sometimes the forked process can throw an exception
+to exit. If you forked below an eval the exception will be cought and you
+suddenly have an unexpected process running amok. This module can be used to
+protect you from such issues.
+
+=head1 SYNOPSYS
+
+    eval {
+        ...
+
+        my $pid = fork;
+
+        unless($pid) {
+            require Test::Stream::ForceExit;
+            my $force_exit = Test::Stream::ForceExit->new;
+
+            thing_that_can_die();
+
+            # We did not die, turn off the forced exit.
+            $force_exit->done(1);
+
+            # Do the exit we intend.
+            exit 0;
+        }
+
+        ...
+    }
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm
index 48e6c7d..8d1f6f4 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_076';
+our $VERSION = '1.301001_077';
 $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 b1ac438..d4c1b08 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_076';
+our $VERSION = '1.301001_077';
 $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 18c6d2c..d45dbc7 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_076';
+our $VERSION = '1.301001_077';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 sub import {
diff --git a/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t b/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t
index 44a586c..fae3783 100644
--- a/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t
+++ b/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t
@@ -2,31 +2,7 @@
 use strict;
 use warnings;
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
-
-use threads;
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More;
 
 subtest my_subtest => sub {
diff --git a/cpan/Test-Simple/t/Behavior/fork_new_end.t b/cpan/Test-Simple/t/Behavior/fork_new_end.t
index d15b9d9..7e7c2d7 100644
--- a/cpan/Test-Simple/t/Behavior/fork_new_end.t
+++ b/cpan/Test-Simple/t/Behavior/fork_new_end.t
@@ -8,30 +8,7 @@ BEGIN {
     }
 }
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
-
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More tests => 4;
 
 ok(1, "outside before");
diff --git a/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t b/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
index 5f73ffa..71a80e9 100644
--- a/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
+++ b/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
@@ -1,47 +1,28 @@
 #!/usr/bin/perl -w -T
+use strict;
+use warnings;
 
 BEGIN {
-    if( $ENV{PERL_CORE} ) {
+    if ($ENV{PERL_CORE}) {
         chdir 't';
         @INC = '../lib';
     }
 }
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
+use Test::CanThread qw/AUTHOR_TESTING/;
 
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
-
-use strict;
 use Test::Builder;
 
 my $Test = Test::Builder->new;
 $Test->exported_to('main');
 $Test->plan(tests => 6);
 
-for(1..5) {
-	'threads'->create(sub {
-          $Test->ok(1,"Each of these should app the test number")
-    })->join;
+for (1 .. 5) {
+    'threads'->create(
+        sub {
+            $Test->ok(1, "Each of these should app the test number");
+        }
+    )->join;
 }
 
-$Test->is_num($Test->current_test(), 5,"Should be five");
+$Test->is_num($Test->current_test(), 5, "Should be five");
diff --git a/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
index 5e20d81..5adb739 100644
--- a/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
@@ -1,27 +1,15 @@
 #!perl -w
 use strict;
 use warnings;
+
+use Test::CanFork;
+
 use IO::Pipe;
 use Test::Builder;
-use Config;
 
 my $b = Test::Builder->new;
 $b->reset;
-
-my $Can_Fork = $Config{d_fork}
-    || (($^O eq 'MSWin32' || $^O eq 'NetWare')
-    and $Config{useithreads}
-    and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
-
-if (!$Can_Fork) {
-    $b->plan('skip_all' => "This system cannot fork");
-}
-elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-    $b->plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
-}
-else {
-    $b->plan('tests' => 2);
-}
+$b->plan('tests' => 2);
 
 my $pipe = IO::Pipe->new;
 if (my $pid = fork) {
diff --git a/cpan/Test-Simple/t/Legacy/fork.t b/cpan/Test-Simple/t/Legacy/fork.t
index ad02824..da7d464 100644
--- a/cpan/Test-Simple/t/Legacy/fork.t
+++ b/cpan/Test-Simple/t/Legacy/fork.t
@@ -7,24 +7,9 @@ BEGIN {
     }
 }
 
-use Test::More;
-use Config;
+use Test::CanFork;
 
-my $Can_Fork = $Config{d_fork} ||
-               (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                $Config{useithreads} and
-                $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-               );
-
-if( !$Can_Fork ) {
-    plan skip_all => "This system cannot fork";
-}
-elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-    plan 'skip_all' => "5.10 has fork/threading issues that break fork on win32";
-}
-else {
-    plan tests => 1;
-}
+use Test::More tests => 1;
 
 my $pid = fork;
 if( $pid ) { # parent
diff --git a/cpan/Test-Simple/t/Legacy/fork_die.t b/cpan/Test-Simple/t/Legacy/fork_die.t
index d649e1a..6728e28 100644
--- a/cpan/Test-Simple/t/Legacy/fork_die.t
+++ b/cpan/Test-Simple/t/Legacy/fork_die.t
@@ -1,27 +1,16 @@
 use strict;
 use warnings;
 
-use Config;
-
 BEGIN {
-    my $Can_Fork = $Config{d_fork} ||
-                   (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                    $Config{useithreads} and
-                    $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-                   );
-
-    if( !$Can_Fork ) {
-        require Test::More;
-        Test::More::plan(skip_all => "This system cannot fork");
-        exit 0;
-    }
-    elsif ($^O eq 'MSWin32' && $] == 5.010000) {
+    if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
         require Test::More;
-        Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
+        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,
 # both with the same test number. If this test file does anything other than 1
 # (non-indented) result that passes, it has failed in one way or another.
diff --git a/cpan/Test-Simple/t/Legacy/fork_in_subtest.t b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
index b89cc5c..1a8dc16 100644
--- a/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
+++ b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
@@ -1,26 +1,7 @@
 use strict;
 use warnings;
 
-use Config;
-
-BEGIN {
-    my $Can_Fork = $Config{d_fork} ||
-                   (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                    $Config{useithreads} and
-                    $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-                   );
-
-    if( !$Can_Fork ) {
-        require Test::More;
-        Test::More::plan(skip_all => "This system cannot fork");
-        exit 0;
-    }
-    elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-        require Test::More;
-        Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
-        exit 0;
-    }
-}
+use Test::CanFork;
 
 use Test::Stream 'enable_fork';
 use Test::More;
diff --git a/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
index 66a6641..50d2004 100644
--- a/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
+++ b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
@@ -13,29 +13,8 @@ BEGIN {
 }
 
 use strict;
-use Config;
 
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
+use Test::CanThread qw/AUTHOR_TESTING/;
 
 use Test::More;
 
diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
index 32a7d1f..bbf3b67 100644
--- a/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
+++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
@@ -1,37 +1,4 @@
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ($ENV{AUTHOR_TESTING}) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-
-    if ($INC{'Devel/Cover.pm'}) {
-        print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
-        exit 0;
-    }
-}
-
-use threads;
-
-use strict;
-use warnings;
-
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More;
 
 # basic tests
diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
index c60c61e..411a463 100644
--- a/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
+++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
@@ -1,37 +1,7 @@
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ($ENV{AUTHOR_TESTING}) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-
-    if ($INC{'Devel/Cover.pm'}) {
-        print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
-        exit 0;
-    }
-}
-
-use threads;
-
 use strict;
 use warnings;
 
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More;
 
 {
diff --git a/cpan/Test-Simple/t/Legacy/subtest/basic.t b/cpan/Test-Simple/t/Legacy/subtest/basic.t
index 964b60d..5a0166d 100644
--- a/cpan/Test-Simple/t/Legacy/subtest/basic.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/basic.t
@@ -15,7 +15,7 @@ use warnings;
 
 use Test::Builder::NoOutput;
 
-use Test::More tests => 18;
+use Test::More tests => 16;
 
 # Formatting may change if we're running under Test::Harness.
 $ENV{HARNESS_ACTIVE} = 0;
@@ -168,8 +168,6 @@ END
     {
         my $child = $tb->child('skippy says he loves you');
         eval { $child->plan( skip_all => 'cuz I said so' ) };
-        ok my $error = $@, 'A child which does a "skip_all" should throw an exception';
-        isa_ok $error, 'Test::Stream::Event', '... and the exception it throws';
     }
     subtest 'skip all', sub {
         plan skip_all => 'subtest with skip_all';
diff --git a/cpan/Test-Simple/t/Legacy/subtest/fork.t b/cpan/Test-Simple/t/Legacy/subtest/fork.t
index 76e9493..8d763a4 100644
--- a/cpan/Test-Simple/t/Legacy/subtest/fork.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/fork.t
@@ -1,26 +1,12 @@
 #!/usr/bin/perl -w
 use strict;
 use warnings;
-use Config;
+
+use Test::CanFork;
+
 use IO::Pipe;
 use Test::Builder;
-use Test::More;
-
-my $Can_Fork = $Config{d_fork} ||
-               (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                $Config{useithreads} and
-                $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-               );
-
-if( !$Can_Fork ) {
-    plan 'skip_all' => "This system cannot fork";
-}
-elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-    plan 'skip_all' => "5.10 has fork/threading issues that break fork on win32";
-}
-else {
-    plan 'tests' => 1;
-}
+use Test::More tests => 1;
 
 subtest 'fork within subtest' => sub {
     plan tests => 2;
diff --git a/cpan/Test-Simple/t/Legacy/subtest/threads.t b/cpan/Test-Simple/t/Legacy/subtest/threads.t
index 5d053ca..df00f40 100644
--- a/cpan/Test-Simple/t/Legacy/subtest/threads.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/threads.t
@@ -3,15 +3,7 @@
 use strict;
 use warnings;
 
-use Config;
-BEGIN {
-    unless ( $] >= 5.008001 && $Config{'useithreads'} &&
-             eval { require threads; 'threads'->import; 1; })
-    {
-        print "1..0 # Skip: no working threads\n";
-        exit 0;
-    }
-}
+use Test::CanThread;
 
 use Test::More;
 
diff --git a/cpan/Test-Simple/t/Legacy/threads.t b/cpan/Test-Simple/t/Legacy/threads.t
index 51b374d..28b0bd1 100644
--- a/cpan/Test-Simple/t/Legacy/threads.t
+++ b/cpan/Test-Simple/t/Legacy/threads.t
@@ -7,29 +7,7 @@ BEGIN {
     }
 }
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
+use Test::CanThread qw/AUTHOR_TESTING/;
 
 use strict;
 use Test::Builder;
diff --git a/cpan/Test-Simple/t/Test-Stream-ForceExit.t b/cpan/Test-Simple/t/Test-Stream-ForceExit.t
new file mode 100644
index 0000000..6bae48c
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-ForceExit.t
@@ -0,0 +1,69 @@
+use Test::Stream::ForceExit;
+use strict;
+use warnings;
+
+use Test::CanFork;
+
+use Test::Stream qw/enable_fork/;
+use Test::More;
+use Test::Stream::ForceExit;
+
+my ($read, $write);
+pipe($read, $write) || die "Failed to create a pipe.";
+
+my $pid = fork();
+unless ($pid) {
+    die "Failed to fork" unless defined $pid;
+    close($read);
+    $SIG{__WARN__} = sub { print $write @_ };
+
+    {
+        my $force_exit = Test::Stream::ForceExit->new;
+        diag "In Child";
+    }
+
+    print $write "Did not exit!";
+
+    ok(0, "Failed to exit");
+    exit 0;
+}
+
+close($write);
+waitpid($pid, 0);
+my $error = $?;
+ok($error, "Got an error");
+my $msg = join("", <$read>);
+is($msg, <<EOT, "Got warning");
+Something prevented child process $pid from exiting when it should have, Forcing exit now!
+EOT
+
+close($read);
+pipe($read, $write) || die "Failed to create a pipe.";
+
+$pid = fork();
+unless ($pid) {
+    die "Failed to fork" unless defined $pid;
+    close($read);
+    $SIG{__WARN__} = sub { print $write @_ };
+
+    {
+        my $force_exit = Test::Stream::ForceExit->new;
+        diag "In Child $$";
+        $force_exit->done(1);
+    }
+
+    print $write "Did not exit!\n";
+
+    exit 0;
+}
+
+close($write);
+waitpid($pid, 0);
+$error = $?;
+ok(!$error, "no error");
+$msg = join("", <$read>);
+is($msg, <<EOT, "Did not exit early");
+Did not exit!
+EOT
+
+done_testing;
-- 
1.9.1

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @bulk88

On Sat Nov 22 20​:12​:04 2014, exodist7@​gmail.com wrote​:

However if the issue highlighted is actually a bug in perl itself, I
have
no objections to having it fixed :-).

-Chad

At my_perl->Ierrgv->sv_u.svu_gp->gp_sv and curcop

In Test​::Stream​::Util

sub try(&) {
  my $code = shift;
  my $error;
  my $ok;

  {
  local ($@​, $!, $SIG{__DIE__});<<<<<<<<<<<CURCOP
  $ok = eval { $code->(); 1 } || 0;
  unless($ok) {
  $error = $@​ || "Error was squashed!\n";
  }
  study "";
  }

  return wantarray ? ($ok, $error) : $ok;
}

  perl521.dll!Perl_leave_scope(interpreter * my_perl=0x00ccf81c, long base=35) Line 828 C
  perl521.dll!Perl_pop_scope(interpreter * my_perl=0x00ccf81c) Line 104 + 0x18 C
  perl521.dll!Perl_pp_leaveloop(interpreter * my_perl=0x00ccf81c) Line 2263 + 0xa7 C
  perl521.dll!Perl_runops_debug(interpreter * my_perl=0x00ccf81c) Line 2242 + 0xd C
  perl521.dll!win32_start_child(void * arg=0x00ccf81c) Line 1772 + 0xd C++
  kernel32.dll!_BaseThreadStart@​8() + 0x37

  case SAVEt_SV​: /* scalar reference */
  svp = &GvSV(ARG1_GV);
  refsv = ARG1_SV; /* what to refcnt_dec */
  restore_sv​:
  {
  SV * const sv = *svp;
  *svp = ARG0_SV;
  SvREFCNT_dec(sv);
  if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
  PL_localizing = 2;
  mg_set(ARG0_SV);
  PL_localizing = 0;
  }
  SvREFCNT_dec_NN(ARG0_SV);<<<<<<<<<<<$@​ got freed
  SvREFCNT_dec(refsv);
  break;
  }

I am going to say this is the same bug as in #40565 .

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Nov 23, 2014

From @exodist

Yikes, just cought up on that ticket... yeah, just gonna skip the test on
windows. Though this explains why most forking tests using Test​::Builder
have issues on windows! I have always wondered what it was.

I may put a hack in Test​::Builder to not localize certain ones, or manually
stash and restore them when windows is in use to fix a LOT of things that
simply do not work in windows.

On Sat, Nov 22, 2014, 9​:58 PM bulk88 via RT <perlbug-followup@​perl.org>
wrote​:

On Sat Nov 22 20​:12​:04 2014, exodist7@​gmail.com wrote​:

However if the issue highlighted is actually a bug in perl itself, I
have
no objections to having it fixed :-).

-Chad

At my_perl->Ierrgv->sv_u.svu_gp->gp_sv and curcop

In Test​::Stream​::Util

sub try(&) {
my $code = shift;
my $error;
my $ok;

\{
    local \($@&#8203;\, $\!\, $SIG\{\_\_DIE\_\_\}\);\<\<\<\<\<\<\<\<\<\<\<CURCOP
    $ok = eval \{ $code\->\(\); 1 \} || 0;
    unless\($ok\) \{
        $error = $@&#8203; || "Error was squashed\!\\n";
    \}
    study "";
\}

return wantarray ? \($ok\, $error\) : $ok;

}

    perl521\.dll\!Perl\_leave\_scope\(interpreter \* my\_perl=0x00ccf81c\,

long base=35) Line 828 C
perl521.dll!Perl_pop_scope(interpreter * my_perl=0x00ccf81c)
Line 104 + 0x18 C
perl521.dll!Perl_pp_leaveloop(interpreter * my_perl=0x00ccf81c)
Line 2263 + 0xa7 C
perl521.dll!Perl_runops_debug(interpreter * my_perl=0x00ccf81c)
Line 2242 + 0xd C
perl521.dll!win32_start_child(void * arg=0x00ccf81c) Line 1772 +
0xd C++
kernel32.dll!_BaseThreadStart@​8() + 0x37

    case SAVEt\_SV&#8203;:                          /\* scalar reference \*/
        svp = &GvSV\(ARG1\_GV\);
        refsv = ARG1\_SV; /\* what to refcnt\_dec \*/
    restore\_sv&#8203;:
    \{
        SV \* const sv = \*svp;
        \*svp = ARG0\_SV;
        SvREFCNT\_dec\(sv\);
        if \(UNLIKELY\(SvSMAGICAL\(ARG0\_SV\)\)\) \{
            PL\_localizing = 2;
            mg\_set\(ARG0\_SV\);
            PL\_localizing = 0;
        \}
        SvREFCNT\_dec\_NN\(ARG0\_SV\);\<\<\<\<\<\<\<\<\<\<\<$@&#8203; got freed
        SvREFCNT\_dec\(refsv\);
        break;
    \}

I am going to say this is the same bug as in #40565 .

--
bulk88 ~ bulk88 at hotmail.com

---
via perlbug​: queue​: perl5 status​: open
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=123277

@p5pRT
Copy link
Author

p5pRT commented Nov 24, 2014

From @exodist

Here is a patch to alpha 078, This should fix the windows issues. It also won't explode like the 077 patch would have if it had been applied.

Notes​:
* Skip problematic test on windows, it doesn't really apply to windows systems anyway
* Revert flow-control change that broke an incredible amount of stuff.

This patch applies to current blead, do not apply any other patches in this ticket (also do not revert the one that was already applied)

@p5pRT
Copy link
Author

p5pRT commented Nov 24, 2014

From @exodist

0001-Update-Test-Simple-to-Alpha-078.patch 
From b10acf6833d51f8c132c6bde93b2c1d3a46f30d7 Mon Sep 17 00:00:00 2001
From: Chad Granum <chad.granum@dreamhost.com>
Date: Sun, 23 Nov 2014 16:24:50 -0800
Subject: [PATCH] Update Test-Simple to Alpha 078

---
 MANIFEST                                           |   4 +
 cpan/Test-Simple/lib/Test/Builder.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/CanFork.pm               |  94 +++++++++++++++++++
 cpan/Test-Simple/lib/Test/CanThread.pm             | 103 +++++++++++++++++++++
 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/ForceExit.pm      |  97 +++++++++++++++++++
 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/Behavior/388-threadedsubtest.t  |  26 +-----
 cpan/Test-Simple/t/Behavior/fork_new_end.t         |  25 +----
 .../t/Behavior/threads_with_taint_mode.t           |  41 +++-----
 .../t/Legacy/Builder/fork_with_new_stdout.t        |  20 +---
 cpan/Test-Simple/t/Legacy/fork.t                   |  19 +---
 cpan/Test-Simple/t/Legacy/fork_die.t               |  19 +---
 cpan/Test-Simple/t/Legacy/fork_in_subtest.t        |  21 +----
 cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t |  23 +----
 cpan/Test-Simple/t/Legacy/ribasushi_threads.t      |  35 +------
 cpan/Test-Simple/t/Legacy/ribasushi_threads2.t     |  32 +------
 cpan/Test-Simple/t/Legacy/subtest/fork.t           |  22 +----
 cpan/Test-Simple/t/Legacy/subtest/threads.t        |  10 +-
 cpan/Test-Simple/t/Legacy/threads.t                |  24 +----
 cpan/Test-Simple/t/Test-Stream-ForceExit.t         |  69 ++++++++++++++
 28 files changed, 411 insertions(+), 295 deletions(-)
 create mode 100644 cpan/Test-Simple/lib/Test/CanFork.pm
 create mode 100644 cpan/Test-Simple/lib/Test/CanThread.pm
 create mode 100644 cpan/Test-Simple/lib/Test/Stream/ForceExit.pm
 create mode 100644 cpan/Test-Simple/t/Test-Stream-ForceExit.t

diff --git a/MANIFEST b/MANIFEST
index bd4a00a..f5126e0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2259,6 +2259,8 @@ cpan/Test-Simple/lib/Test/Builder/Module.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Builder.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Builder/Tester.pm			Test::Simple module
+cpan/Test-Simple/lib/Test/CanFork.pm			Test::Simple module
+cpan/Test-Simple/lib/Test/CanThread.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/FAQ.pod			Test::Simple module
 cpan/Test-Simple/lib/Test/More/DeepCheck.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/More/DeepCheck/Strict.pm			Test::Simple module
@@ -2285,6 +2287,7 @@ cpan/Test-Simple/lib/Test/Stream/ExitMagic/Context.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/ExitMagic.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/Exporter/Meta.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/Exporter.pm			Test::Simple module
+cpan/Test-Simple/lib/Test/Stream/ForceExit.pm			Test-Simple module
 cpan/Test-Simple/lib/Test/Stream/IOSets.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/Meta.pm			Test::Simple module
 cpan/Test-Simple/lib/Test/Stream/PackageUtil.pm			Test::Simple module
@@ -2486,6 +2489,7 @@ cpan/Test-Simple/t/Test-Stream-Event.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-ExitMagic-Context.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-Exporter-Meta.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-Exporter.t			Test::Simple Test
+cpan/Test-Simple/t/Test-Stream-ForceExit.t			Test-Simple test
 cpan/Test-Simple/t/Test-Stream-IOSets.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-Meta.t			Test::Simple Test
 cpan/Test-Simple/t/Test-Stream-PackageUtil.t			Test::Simple Test
diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm
index aa9a417..2144c93 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_076';
+our $VERSION = '1.301001_078';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 
diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm
index 79340ed..0ff9ce1 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_076';
+our $VERSION = '1.301001_078';
 $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 dfdfc5e..7b2e9b4 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_076';
+our $VERSION = '1.301001_078';
 $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 6498c6a..dfdb50d 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_076';
+our $VERSION = '1.301001_078';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream 1.301001 '-internal';
diff --git a/cpan/Test-Simple/lib/Test/CanFork.pm b/cpan/Test-Simple/lib/Test/CanFork.pm
new file mode 100644
index 0000000..b28a382
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/CanFork.pm
@@ -0,0 +1,94 @@
+package Test::CanFork;
+use strict;
+use warnings;
+
+use Config;
+
+my $Can_Fork = $Config{d_fork}
+    || (($^O eq 'MSWin32' || $^O eq 'NetWare')
+    and $Config{useithreads}
+    and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
+
+if (!$Can_Fork) {
+    require Test::More;
+    Test::More::plan(skip_all => "This system cannot fork");
+    exit 0;
+}
+
+if ($^O eq 'MSWin32' && $] == 5.010000) {
+    require Test::More;
+    Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
+    exit 0;
+}
+
+sub import {
+    my $class = shift;
+    for my $var (@_) {
+        next if $ENV{$var};
+
+        require Test::More;
+        Test::More::plan(skip_all => "This forking test will only run when the '$var' environment variable is set.");
+        exit 0;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::CanFork - Only run tests when forking is supported, optionally conditioned on ENV vars.
+
+=head1 DESCRIPTION
+
+Use this first thing in a test that should be skipped when forking is not
+supported. You can also specify that the test should be skipped when specific
+environment variables are not set.
+
+=head1 SYNOPSYS
+
+Skip the test if forking is unsupported:
+
+    use Test::CanFork;
+    use Test::More;
+    ...
+
+Skip the test if forking is unsupported, or any of the specified env vars are
+not set:
+
+    use Test::CanFork qw/AUTHOR_TESTING RUN_PROBLEMATIC_TESTS .../;
+    use Test::More;
+    ...
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test/CanThread.pm b/cpan/Test-Simple/lib/Test/CanThread.pm
new file mode 100644
index 0000000..a9d6aeb
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/CanThread.pm
@@ -0,0 +1,103 @@
+package Test::CanThread;
+use strict;
+use warnings;
+
+use Config;
+
+if ($] == 5.010000) {
+    require Test::More;
+    Test::More::plan(skip_all => "Threads are broken on 5.10.0");
+    exit 0;
+}
+
+my $works = 1;
+$works &&= $] >= 5.008001;
+$works &&= $Config{'useithreads'};
+$works &&= eval { require threads; 'threads'->import; 1 };
+
+unless ($works) {
+    require Test::More;
+    Test::More::plan(skip_all => "Skip no working threads");
+    exit 0;
+}
+
+if ($INC{'Devel/Cover.pm'}) {
+    require Test::More;
+    Test::More::plan(skip_all => "Devel::Cover does not work with threads yet");
+    exit 0;
+}
+
+sub import {
+    my $class = shift;
+    while(my $var = shift(@_)) {
+        next if $ENV{$var};
+
+        require Test::More;
+        Test::More::plan(skip_all => "This threaded test will only run when the '$var' environment variable is set.");
+        exit 0;
+    }
+
+    unshift @_ => 'threads';
+    goto &threads::import;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::CanThread - Only run tests when threading is supported, optionally conditioned on ENV vars.
+
+=head1 DESCRIPTION
+
+Use this first thing in a test that should be skipped when threading is not
+supported. You can also specify that the test should be skipped when specific
+environment variables are not set.
+
+=head1 SYNOPSYS
+
+Skip the test if threading is unsupported:
+
+    use Test::CanThread;
+    use Test::More;
+    ...
+
+Skip the test if threading is unsupported, or any of the specified env vars are
+not set:
+
+    use Test::CanThread qw/AUTHOR_TESTING RUN_PROBLEMATIC_TESTS .../;
+    use Test::More;
+    ...
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm
index d1b7e65..585fd8a 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_076';
+our $VERSION = '1.301001_078';
 $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 297c490..61cc2c3 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_076';
+our $VERSION = '1.301001_078';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-use Test::Stream 1.301001_076 '-internal';
+use Test::Stream 1.301001_078 '-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 6decda3..2011c5b 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_076';
+our $VERSION = '1.301001_078';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream::Context qw/context/;
diff --git a/cpan/Test-Simple/lib/Test/Stream/ForceExit.pm b/cpan/Test-Simple/lib/Test/Stream/ForceExit.pm
new file mode 100644
index 0000000..e32edfb
--- /dev/null
+++ b/cpan/Test-Simple/lib/Test/Stream/ForceExit.pm
@@ -0,0 +1,97 @@
+package Test::Stream::ForceExit;
+use strict;
+use warnings;
+
+sub new {
+    my $class = shift;
+
+    my $done = 0;
+    my $self = \$done;
+
+    return bless $self, $class;
+}
+
+sub done {
+    my $self = shift;
+    ($$self) = @_ if @_;
+    return $$self;
+}
+
+sub DESTROY {
+    my $self = shift;
+    return if $self->done;
+
+    warn "Something prevented child process $$ from exiting when it should have, Forcing exit now!\n";
+    $self->done(1); # Prevent duplicate message during global destruction
+    exit 255;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Test::ForceExit - Ensure C<exit()> is called bvy the end of a scope, force the issue.
+
+=head1 DESCRIPTION
+
+Sometimes you need to fork. Sometimes the forked process can throw an exception
+to exit. If you forked below an eval the exception will be cought and you
+suddenly have an unexpected process running amok. This module can be used to
+protect you from such issues.
+
+=head1 SYNOPSYS
+
+    eval {
+        ...
+
+        my $pid = fork;
+
+        unless($pid) {
+            require Test::Stream::ForceExit;
+            my $force_exit = Test::Stream::ForceExit->new;
+
+            thing_that_can_die();
+
+            # We did not die, turn off the forced exit.
+            $force_exit->done(1);
+
+            # Do the exit we intend.
+            exit 0;
+        }
+
+        ...
+    }
+
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/Test-More/test-more/>.
+
+=head1 MAINTAINER
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm
index 48e6c7d..5fd8b11 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_076';
+our $VERSION = '1.301001_078';
 $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 b1ac438..72e9437 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_076';
+our $VERSION = '1.301001_078';
 $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 18c6d2c..b83c7ec 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_076';
+our $VERSION = '1.301001_078';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 sub import {
diff --git a/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t b/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t
index 44a586c..fae3783 100644
--- a/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t
+++ b/cpan/Test-Simple/t/Behavior/388-threadedsubtest.t
@@ -2,31 +2,7 @@
 use strict;
 use warnings;
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
-
-use threads;
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More;
 
 subtest my_subtest => sub {
diff --git a/cpan/Test-Simple/t/Behavior/fork_new_end.t b/cpan/Test-Simple/t/Behavior/fork_new_end.t
index d15b9d9..7e7c2d7 100644
--- a/cpan/Test-Simple/t/Behavior/fork_new_end.t
+++ b/cpan/Test-Simple/t/Behavior/fork_new_end.t
@@ -8,30 +8,7 @@ BEGIN {
     }
 }
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
-
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More tests => 4;
 
 ok(1, "outside before");
diff --git a/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t b/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
index 5f73ffa..71a80e9 100644
--- a/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
+++ b/cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t
@@ -1,47 +1,28 @@
 #!/usr/bin/perl -w -T
+use strict;
+use warnings;
 
 BEGIN {
-    if( $ENV{PERL_CORE} ) {
+    if ($ENV{PERL_CORE}) {
         chdir 't';
         @INC = '../lib';
     }
 }
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
+use Test::CanThread qw/AUTHOR_TESTING/;
 
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
-
-use strict;
 use Test::Builder;
 
 my $Test = Test::Builder->new;
 $Test->exported_to('main');
 $Test->plan(tests => 6);
 
-for(1..5) {
-	'threads'->create(sub {
-          $Test->ok(1,"Each of these should app the test number")
-    })->join;
+for (1 .. 5) {
+    'threads'->create(
+        sub {
+            $Test->ok(1, "Each of these should app the test number");
+        }
+    )->join;
 }
 
-$Test->is_num($Test->current_test(), 5,"Should be five");
+$Test->is_num($Test->current_test(), 5, "Should be five");
diff --git a/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
index 5e20d81..5adb739 100644
--- a/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
+++ b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
@@ -1,27 +1,15 @@
 #!perl -w
 use strict;
 use warnings;
+
+use Test::CanFork;
+
 use IO::Pipe;
 use Test::Builder;
-use Config;
 
 my $b = Test::Builder->new;
 $b->reset;
-
-my $Can_Fork = $Config{d_fork}
-    || (($^O eq 'MSWin32' || $^O eq 'NetWare')
-    and $Config{useithreads}
-    and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
-
-if (!$Can_Fork) {
-    $b->plan('skip_all' => "This system cannot fork");
-}
-elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-    $b->plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
-}
-else {
-    $b->plan('tests' => 2);
-}
+$b->plan('tests' => 2);
 
 my $pipe = IO::Pipe->new;
 if (my $pid = fork) {
diff --git a/cpan/Test-Simple/t/Legacy/fork.t b/cpan/Test-Simple/t/Legacy/fork.t
index ad02824..da7d464 100644
--- a/cpan/Test-Simple/t/Legacy/fork.t
+++ b/cpan/Test-Simple/t/Legacy/fork.t
@@ -7,24 +7,9 @@ BEGIN {
     }
 }
 
-use Test::More;
-use Config;
+use Test::CanFork;
 
-my $Can_Fork = $Config{d_fork} ||
-               (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                $Config{useithreads} and
-                $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-               );
-
-if( !$Can_Fork ) {
-    plan skip_all => "This system cannot fork";
-}
-elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-    plan 'skip_all' => "5.10 has fork/threading issues that break fork on win32";
-}
-else {
-    plan tests => 1;
-}
+use Test::More tests => 1;
 
 my $pid = fork;
 if( $pid ) { # parent
diff --git a/cpan/Test-Simple/t/Legacy/fork_die.t b/cpan/Test-Simple/t/Legacy/fork_die.t
index d649e1a..6728e28 100644
--- a/cpan/Test-Simple/t/Legacy/fork_die.t
+++ b/cpan/Test-Simple/t/Legacy/fork_die.t
@@ -1,27 +1,16 @@
 use strict;
 use warnings;
 
-use Config;
-
 BEGIN {
-    my $Can_Fork = $Config{d_fork} ||
-                   (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                    $Config{useithreads} and
-                    $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-                   );
-
-    if( !$Can_Fork ) {
-        require Test::More;
-        Test::More::plan(skip_all => "This system cannot fork");
-        exit 0;
-    }
-    elsif ($^O eq 'MSWin32' && $] == 5.010000) {
+    if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
         require Test::More;
-        Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
+        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,
 # both with the same test number. If this test file does anything other than 1
 # (non-indented) result that passes, it has failed in one way or another.
diff --git a/cpan/Test-Simple/t/Legacy/fork_in_subtest.t b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
index b89cc5c..1a8dc16 100644
--- a/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
+++ b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t
@@ -1,26 +1,7 @@
 use strict;
 use warnings;
 
-use Config;
-
-BEGIN {
-    my $Can_Fork = $Config{d_fork} ||
-                   (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                    $Config{useithreads} and
-                    $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-                   );
-
-    if( !$Can_Fork ) {
-        require Test::More;
-        Test::More::plan(skip_all => "This system cannot fork");
-        exit 0;
-    }
-    elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-        require Test::More;
-        Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
-        exit 0;
-    }
-}
+use Test::CanFork;
 
 use Test::Stream 'enable_fork';
 use Test::More;
diff --git a/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
index 66a6641..50d2004 100644
--- a/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
+++ b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t
@@ -13,29 +13,8 @@ BEGIN {
 }
 
 use strict;
-use Config;
 
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
+use Test::CanThread qw/AUTHOR_TESTING/;
 
 use Test::More;
 
diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
index 32a7d1f..bbf3b67 100644
--- a/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
+++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t
@@ -1,37 +1,4 @@
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ($ENV{AUTHOR_TESTING}) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-
-    if ($INC{'Devel/Cover.pm'}) {
-        print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
-        exit 0;
-    }
-}
-
-use threads;
-
-use strict;
-use warnings;
-
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More;
 
 # basic tests
diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
index c60c61e..411a463 100644
--- a/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
+++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t
@@ -1,37 +1,7 @@
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ($ENV{AUTHOR_TESTING}) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-
-    if ($INC{'Devel/Cover.pm'}) {
-        print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
-        exit 0;
-    }
-}
-
-use threads;
-
 use strict;
 use warnings;
 
+use Test::CanThread qw/AUTHOR_TESTING/;
 use Test::More;
 
 {
diff --git a/cpan/Test-Simple/t/Legacy/subtest/fork.t b/cpan/Test-Simple/t/Legacy/subtest/fork.t
index 76e9493..8d763a4 100644
--- a/cpan/Test-Simple/t/Legacy/subtest/fork.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/fork.t
@@ -1,26 +1,12 @@
 #!/usr/bin/perl -w
 use strict;
 use warnings;
-use Config;
+
+use Test::CanFork;
+
 use IO::Pipe;
 use Test::Builder;
-use Test::More;
-
-my $Can_Fork = $Config{d_fork} ||
-               (($^O eq 'MSWin32' || $^O eq 'NetWare') and
-                $Config{useithreads} and
-                $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
-               );
-
-if( !$Can_Fork ) {
-    plan 'skip_all' => "This system cannot fork";
-}
-elsif ($^O eq 'MSWin32' && $] == 5.010000) {
-    plan 'skip_all' => "5.10 has fork/threading issues that break fork on win32";
-}
-else {
-    plan 'tests' => 1;
-}
+use Test::More tests => 1;
 
 subtest 'fork within subtest' => sub {
     plan tests => 2;
diff --git a/cpan/Test-Simple/t/Legacy/subtest/threads.t b/cpan/Test-Simple/t/Legacy/subtest/threads.t
index 5d053ca..df00f40 100644
--- a/cpan/Test-Simple/t/Legacy/subtest/threads.t
+++ b/cpan/Test-Simple/t/Legacy/subtest/threads.t
@@ -3,15 +3,7 @@
 use strict;
 use warnings;
 
-use Config;
-BEGIN {
-    unless ( $] >= 5.008001 && $Config{'useithreads'} &&
-             eval { require threads; 'threads'->import; 1; })
-    {
-        print "1..0 # Skip: no working threads\n";
-        exit 0;
-    }
-}
+use Test::CanThread;
 
 use Test::More;
 
diff --git a/cpan/Test-Simple/t/Legacy/threads.t b/cpan/Test-Simple/t/Legacy/threads.t
index 51b374d..28b0bd1 100644
--- a/cpan/Test-Simple/t/Legacy/threads.t
+++ b/cpan/Test-Simple/t/Legacy/threads.t
@@ -7,29 +7,7 @@ BEGIN {
     }
 }
 
-use Config;
-
-BEGIN {
-    if ($] == 5.010000) {
-        print "1..0 # Threads are broken on 5.10.0\n";
-        exit 0;
-    }
-
-    my $works = 1;
-    $works &&= $] >= 5.008001;
-    $works &&= $Config{'useithreads'};
-    $works &&= eval { require threads; 'threads'->import; 1 };
-
-    unless ($works) {
-        print "1..0 # Skip no working threads\n";
-        exit 0;
-    }
-
-    unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
-        exit 0;
-    }
-}
+use Test::CanThread qw/AUTHOR_TESTING/;
 
 use strict;
 use Test::Builder;
diff --git a/cpan/Test-Simple/t/Test-Stream-ForceExit.t b/cpan/Test-Simple/t/Test-Stream-ForceExit.t
new file mode 100644
index 0000000..6bae48c
--- /dev/null
+++ b/cpan/Test-Simple/t/Test-Stream-ForceExit.t
@@ -0,0 +1,69 @@
+use Test::Stream::ForceExit;
+use strict;
+use warnings;
+
+use Test::CanFork;
+
+use Test::Stream qw/enable_fork/;
+use Test::More;
+use Test::Stream::ForceExit;
+
+my ($read, $write);
+pipe($read, $write) || die "Failed to create a pipe.";
+
+my $pid = fork();
+unless ($pid) {
+    die "Failed to fork" unless defined $pid;
+    close($read);
+    $SIG{__WARN__} = sub { print $write @_ };
+
+    {
+        my $force_exit = Test::Stream::ForceExit->new;
+        diag "In Child";
+    }
+
+    print $write "Did not exit!";
+
+    ok(0, "Failed to exit");
+    exit 0;
+}
+
+close($write);
+waitpid($pid, 0);
+my $error = $?;
+ok($error, "Got an error");
+my $msg = join("", <$read>);
+is($msg, <<EOT, "Got warning");
+Something prevented child process $pid from exiting when it should have, Forcing exit now!
+EOT
+
+close($read);
+pipe($read, $write) || die "Failed to create a pipe.";
+
+$pid = fork();
+unless ($pid) {
+    die "Failed to fork" unless defined $pid;
+    close($read);
+    $SIG{__WARN__} = sub { print $write @_ };
+
+    {
+        my $force_exit = Test::Stream::ForceExit->new;
+        diag "In Child $$";
+        $force_exit->done(1);
+    }
+
+    print $write "Did not exit!\n";
+
+    exit 0;
+}
+
+close($write);
+waitpid($pid, 0);
+$error = $?;
+ok(!$error, "no error");
+$msg = join("", <$read>);
+is($msg, <<EOT, "Did not exit early");
+Did not exit!
+EOT
+
+done_testing;
-- 
1.9.1

@p5pRT
Copy link
Author

p5pRT commented Nov 24, 2014

From @cpansprout

On Sun Nov 23 16​:45​:37 2014, exodist7@​gmail.com wrote​:

Here is a patch to alpha 078, This should fix the windows issues. It
also won't explode like the 077 patch would have if it had been
applied.

Notes​:
* Skip problematic test on windows, it doesn't really apply to windows
systems anyway
* Revert flow-control change that broke an incredible amount of stuff.

This patch applies to current blead, do not apply any other patches in
this ticket (also do not revert the one that was already applied)

Thank you. Applied as 2e52a9b.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 24, 2014

@cpansprout - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this as completed Nov 24, 2014
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Assignees
No one assigned
Labels
hasPatch
Projects
None yet
Milestone
No milestone
Development

No branches or pull requests
1 participant
@p5pRT