[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;
+