Extend the $? fix from 6d3e0a6f to the threadtest, make things more robust

diff --git a/Makefile.PL b/Makefile.PL
index efc983e..bbdc96a 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-require 5.006000;
+require 5.008001;
 
 use ExtUtils::MakeMaker;
 BEGIN { if ( $^O eq 'cygwin' ) {
@@ -34,7 +34,7 @@ my %WriteMakefileArgs = (
   LICENSE             => 'perl',
   INSTALLDIRS         => 'site',
   PL_FILES            => { },
-  MIN_PERL_VERSION    => '5.006000',
+  MIN_PERL_VERSION    => '5.008001',
   PREREQ_PM           => \%RUN_DEPS,
   CONFIGURE_REQUIRES  => { 'ExtUtils::CBuilder' => 0.27 },
   META_ADD => {

diff --git a/t/01_basic.t b/t/01_basic.t
index b156506..3c3ffbd 100644 (file)
--- a/t/01_basic.t
+++ b/t/01_basic.t
@@ -21,8 +21,30 @@ BEGIN {
 
 print "1..6\n";
 
-my $had_error = 0;
-END { $? = $had_error };
+our $had_error;
+
+# try to ensure this is the last-most END so we capture future tests
+# running in other ENDs
+require B;
+my $reinject_retries = my $max_retry = 5;
+my $end_worker;
+$end_worker = sub {
+  my $tail = (B::end_av()->ARRAY)[-1];
+  if (!defined $tail or $tail == $end_worker) {
+    $? = $had_error || 0;
+    $reinject_retries = 0;
+  }
+  elsif ($reinject_retries--) {
+    push @{B::end_av()->object_2svref}, $end_worker;
+  }
+  else {
+    print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n";
+    require POSIX;
+    POSIX::_exit( 255 );
+  }
+};
+END { push @{B::end_av()->object_2svref}, $end_worker }
+
 sub ok ($$) {
   $had_error++, print "not " if !$_[0];
   print "ok";

diff --git a/t/02_thread.t b/t/02_thread.t
index 0b51704..9032546 100644 (file)
--- a/t/02_thread.t
+++ b/t/02_thread.t
@@ -14,8 +14,13 @@ BEGIN {
 }
 
 use threads;
-use warnings;
+use threads::shared;
+
+our $had_error :shared;
+END { $? = $had_error||0 }
+
 use strict;
+use warnings;
 
 BEGIN {
   if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
@@ -29,7 +34,22 @@ BEGIN {
   }
 }
 
-my $t = threads->create(sub { do 't/01_basic.t' });
-$t->join;
+# load it before spawning a thread, that's the whole point
+require Devel::GlobalDestruction;
+
+sub do_test {
+
+  # just die so we don't need to deal with testcount skew
+  unless ( ($_[0]||'') eq 'arg' ) {
+    $had_error++;
+    die "Argument passing failed!";
+  }
+
+  delete $INC{'t/01_basic.t'};
+  do 't/01_basic.t';
+
+  1;
+}
 
-exit 0;
+threads->create('do_test', 'arg')->join
+  or $had_error++;