From: Dave Mitchell <davem@fdisolutions.com>
Date: Fri, 20 Aug 2004 21:20:48 +0000 (+0000)
Subject: a regex in STDOUT destructor coredumped because regex pad already
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=804ffa601be28a067773828f4a48de171077c8b8;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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];
 }
+