From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 23 Jan 2012 06:48:42 +0000 (-0800)
Subject: Don’t allow read-only regexps to be tied
X-Git-Tag: accepted/trunk/20130322.191538~999
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=6dd7c1f1e9477c302194505f6e1aaa57121f68bd;p=platform%2Fupstream%2Fperl.git

Don’t allow read-only regexps to be tied

Since the test triggered another bug in freeing read-only
regexps, this commit fixes that too.
---

diff --git a/sv.c b/sv.c
index 3736e27..3094274 100644
--- a/sv.c
+++ b/sv.c
@@ -5310,7 +5310,7 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
     if (SvREADONLY(sv)) {
 	if (
 	    /* its okay to attach magic to shared strings */
-	    (!SvFAKE(sv) || isGV_with_GP(sv))
+	    !SvIsCOW(sv)
 
 	    && IN_PERL_RUNTIME
 	    && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
@@ -6191,7 +6191,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 		     && !(SvTYPE(sv) == SVt_PVIO
 		     && !(IoFLAGS(sv) & IOf_FAKE_DIRP)))
 		Safefree(SvPVX_mutable(sv));
-	    else if (SvPVX_const(sv) && SvREADONLY(sv) && SvFAKE(sv)) {
+	    else if (SvPVX_const(sv) && SvIsCOW(sv)) {
 		unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
 		SvFAKE_off(sv);
 	    }
diff --git a/t/op/tie.t b/t/op/tie.t
index b333129..9301bb3 100644
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -1030,6 +1030,16 @@ ok
 Modification of a read-only value attempted at - line 16.
 ########
 
+# Similarly, read-only regexps cannot be tied.
+sub TIESCALAR { bless [] }
+$y = ${qr//};
+Internals::SvREADONLY($y,1);
+tie $y, "";
+
+EXPECT
+Modification of a read-only value attempted at - line 6.
+########
+
 # tied() should still work on tied scalars after glob assignment
 sub TIESCALAR {bless[]}
 sub FETCH {*foo}