From: Dave Mitchell <davem@fdisolutions.com>
Date: Fri, 26 Mar 2004 13:05:50 +0000 (+0000)
Subject:  [perl #27040] - hints hash was being double freed on scope exit
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dfa41748806263fb8b5d5fcb051bd36be96fe93c;p=p5sagit%2Fp5-mst-13.2.git

 [perl #27040] - hints hash was being double freed on scope exit

p4raw-id: //depot/perl@22594
---

diff --git a/op.c b/op.c
index 344130c..a13a7ef 100644
--- a/op.c
+++ b/op.c
@@ -1763,13 +1763,11 @@ Perl_scope(pTHX_ OP *o)
     return o;
 }
 
+/* XXX kept for BINCOMPAT only */
 void
 Perl_save_hints(pTHX)
 {
-    SAVEI32(PL_hints);
-    SAVESPTR(GvHV(PL_hintgv));
-    GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));
-    SAVEFREESV(GvHV(PL_hintgv));
+    Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
 }
 
 int
diff --git a/scope.c b/scope.c
index cb56959..452ea77 100644
--- a/scope.c
+++ b/scope.c
@@ -1042,6 +1042,11 @@ Perl_leave_scope(pTHX_ I32 base)
 		GvHV(PL_hintgv) = NULL;
 	    }
 	    *(I32*)&PL_hints = (I32)SSPOPINT;
+	    if (PL_hints & HINT_LOCALIZE_HH) {
+		SvREFCNT_dec((SV*)GvHV(PL_hintgv));
+		GvHV(PL_hintgv) = (HV*)SSPOPPTR;
+	    }
+		    
 	    break;
 	case SAVEt_COMPPAD:
 	    PL_comppad = (PAD*)SSPOPPTR;
diff --git a/scope.h b/scope.h
index 8abeb72..bbb5562 100644
--- a/scope.h
+++ b/scope.h
@@ -152,14 +152,14 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVEOP()	save_op()
 
 #define SAVEHINTS() \
-    STMT_START {				\
-	if (PL_hints & HINT_LOCALIZE_HH)	\
-	    save_hints();			\
-	else {					\
-	    SSCHECK(2);				\
-	    SSPUSHINT(PL_hints);		\
-	    SSPUSHINT(SAVEt_HINTS);		\
-	}					\
+    STMT_START {					\
+	SSCHECK(3);					\
+	if (PL_hints & HINT_LOCALIZE_HH) {		\
+	    SSPUSHPTR(GvHV(PL_hintgv));			\
+	    GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));	\
+	}						\
+	SSPUSHINT(PL_hints);				\
+	SSPUSHINT(SAVEt_HINTS);				\
     } STMT_END
 
 #define SAVECOMPPAD() \
diff --git a/t/comp/hints.t b/t/comp/hints.t
index 1170968..ce923cc 100644
--- a/t/comp/hints.t
+++ b/t/comp/hints.t
@@ -2,7 +2,7 @@
 
 # Tests the scoping of $^H and %^H
 
-BEGIN { print "1..14\n"; }
+BEGIN { print "1..15\n"; }
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
@@ -55,3 +55,15 @@ BEGIN {
     print "not " if $^H & 0x00020000;
     print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
 }
+
+require 'test.pl';
+
+# bug #27040: hints hash was being double-freed
+my $result = runperl(
+    prog => '$^H |= 0x20000; eval q{BEGIN { $^H |= 0x20000 }}',
+    stderr => 1
+);
+print "not " if length $result;
+print "ok 15 - double-freeing hints hash\n";
+print "# got: $result\n" if length $result;
+