Let %^H be modifiable in eval-strings (bug #41531),

by adding a meaning for OPf_SPECIAL on OP_CONST.
Patch by Yves Orton.

p4raw-id: //depot/perl@30644

diff --git a/op.c b/op.c
index e6aadae..c7b31ba 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6037,8 +6037,11 @@ Perl_ck_eval(pTHX_ OP *o)
     }
     o->op_targ = (PADOFFSET)PL_hints;
     if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
-       /* Store a copy of %^H that pp_entereval can pick up */
-       OP *hhop = newSVOP(OP_CONST, 0,
+       /* Store a copy of %^H that pp_entereval can pick up.
+          OPf_SPECIAL flags the opcode as being for this purpose,
+          so that it in turn will return a copy at every
+          eval.*/
+       OP *hhop = newSVOP(OP_CONST, OPf_SPECIAL,
                           (SV*)Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)));
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;

diff --git a/op.h b/op.h
index 1505932..3c77999 100644 (file)
--- a/op.h
+++ b/op.h
@@ -111,6 +111,8 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPf_STACKED    64      /* Some arg is arriving on the stack. */
 #define OPf_SPECIAL    128     /* Do something weird for this op: */
                                /*  On local LVAL, don't init local value. */
+                               /*  On OP_CONST, value is the hints hash for
+                                   eval, so return a copy from pp_const() */
                                /*  On OP_SORT, subroutine is inlined. */
                                /*  On OP_NOT, inversion was implicit. */
                                /*  On OP_LEAVE, don't restore curpm. */

diff --git a/pp_hot.c b/pp_hot.c
index da4148f..10caecb 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -39,7 +39,14 @@ PP(pp_const)
 {
     dVAR;
     dSP;
-    XPUSHs(cSVOP_sv);
+    if ( PL_op->op_flags & OPf_SPECIAL )
+        /* This is a const op added to hold the hints hash for
+           pp_entereval. The hash can be modified by the code
+           being eval'ed, so we return a copy instead. */
+        XPUSHs(sv_2mortal((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)));
+    else
+        /* Normal const. */
+        XPUSHs(cSVOP_sv);
     RETURN;
 }
 

diff --git a/t/comp/hints.t b/t/comp/hints.t
index 32267de..55aeb71 100644 (file)
--- a/t/comp/hints.t
+++ b/t/comp/hints.t
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 
-BEGIN { print "1..15\n"; }
+BEGIN { print "1..17\n"; }
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
@@ -93,3 +93,16 @@ print "not " if length $result;
 print "ok 15 - double-freeing hints hash\n";
 print "# got: $result\n" if length $result;
 
+{
+    BEGIN{$^H{x}=1};
+    for(1..2) {
+        eval q(
+            print $^H{x}==1 && !$^H{y} ? "ok\n" : "not ok\n";
+            $^H{y} = 1;
+        );
+        if ($@) {
+            (my $str = $@)=~s/^/# /gm;
+            print "not ok\n$str\n";
+        }
+    }
+}