From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 19 Mar 2007 23:11:12 +0000 (+0000)
Subject: Let %^H be modifiable in eval-strings (bug #41531),
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0282be9287c81efde41d8df3c62f1c95bb459498;p=p5sagit%2Fp5-mst-13.2.git

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