a regex in STDOUT destructor coredumped because regex pad already

freed

p4raw-id: //depot/perl@23230

diff --git a/perl.c b/perl.c
index 1040163..88f8547 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -487,6 +487,9 @@ perl_destruct(pTHXx)
 #endif
 #endif /* !PERL_MICRO */
 
+    /* reset so print() ends up where we expect */
+    setdefout(Nullgv);
+
 #ifdef USE_ITHREADS
     /* the syntax tree is shared between clones
      * so op_free(PL_main_root) only ReREFCNT_dec's
@@ -628,9 +631,6 @@ perl_destruct(pTHXx)
     PL_dbargs = Nullav;
     PL_debstash = Nullhv;
 
-    /* reset so print() ends up where we expect */
-    setdefout(Nullgv);
-
     SvREFCNT_dec(PL_argvout_stack);
     PL_argvout_stack = Nullav;
 

diff --git a/t/op/ref.t b/t/op/ref.t
index 597e036..a59af93 100755 (executable)
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..69\n";
+print "1..70\n";
 
 require 'test.pl';
 
@@ -368,6 +368,18 @@ print "not " if length $result;
 print "ok ",++$test," - freeing self-referential typeglob\n";
 print "# got: $result\n" if length $result;
 
+# using a regex in the destructor for STDOUT segfaulted because the
+# REGEX pad had already been freed (ithreads build only). The
+# object is required to trigger the early freeing of GV refs to to STDOUT
+
+$result = runperl(
+    prog => '$x=bless[]; sub IO::Handle::DESTROY{$_="bad";s/bad/ok/;print}',
+    stderr => 1
+);
+print "not " unless $result =~ /^(ok)+$/;
+print "ok ",++$test," - STDOUT destructor\n";
+print "# got: $result\n" unless $result =~ /^(ok)+$/;
+
 # test global destruction
 
 ++$test;
@@ -386,3 +398,4 @@ package FINALE;
 DESTROY {
     print $_[0][0];
 }
+