From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 22 Sep 2003 20:31:19 +0000 (+0000)
Subject: When localising a magic value, propagate the readonly flag
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ac117f44706c30c5e23f7295ec8491b4705a1c77;p=p5sagit%2Fp5-mst-13.2.git

When localising a magic value, propagate the readonly flag
only if this scalar has \0 magic or has magic without a
'set' method. (follows change #20479 for bug #23141.)
p4raw-link: @20479 on //depot/perl: 33f3c7b8444b48791ad016570a41a23483d750d2

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

diff --git a/scope.c b/scope.c
index 33d891e..2c2ce36 100644
--- a/scope.c
+++ b/scope.c
@@ -199,9 +199,9 @@ S_save_scalar_at(pTHX_ SV **sptr)
 
     sv = *sptr = NEWSV(0,0);
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+	MAGIC *mg;
 	sv_upgrade(sv, SvTYPE(osv));
 	if (SvGMAGICAL(osv)) {
-	    MAGIC* mg;
 	    bool oldtainted = PL_tainted;
 	    mg_get(osv);		/* note, can croak! */
 	    if (PL_tainting && PL_tainted &&
@@ -214,7 +214,17 @@ S_save_scalar_at(pTHX_ SV **sptr)
 	    PL_tainted = oldtainted;
 	}
 	SvMAGIC(sv) = SvMAGIC(osv);
-	SvFLAGS(sv) |= SvMAGICAL(osv) | SvREADONLY(osv);
+	/* if it's a special scalar or if it has no 'set' magic,
+	 * propagate the SvREADONLY flag. --rgs 20030922 */
+	for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+	    if (SvMAGIC(sv)->mg_type == '\0'
+		    || !SvMAGIC(sv)->mg_virtual->svt_set)
+	    {
+		SvFLAGS(sv) |= SvREADONLY(osv);
+		break;
+	    }
+	}
+	SvFLAGS(sv) |= SvMAGICAL(osv);
 	/* XXX SvMAGIC() is *shared* between osv and sv.  This can
 	 * lead to coredumps when both SVs are destroyed without one
 	 * of their SvMAGIC() slots being NULLed. */
diff --git a/t/op/local.t b/t/op/local.t
index 5a5b7ee..28613e7 100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..78\n";
+print "1..79\n";
 
 sub foo {
     local($a, $b) = @_;
@@ -271,3 +271,8 @@ print "ok 77\n";
 eval { for ($1) { local $_ = 1 } };
 print "not " if $@;
 print "ok 78\n";
+
+# The s/// adds 'g' magic to $_, but it should remain non-readonly
+eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
+print "not " if $@;
+print "ok 79\n";