From 6dd7c1f1e9477c302194505f6e1aaa57121f68bd Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 22 Jan 2012 22:48:42 -0800
Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20allow=20read-only=20regexps=20to?=
 =?utf8?q?=20be=20tied?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Since the test triggered another bug in freeing read-only
regexps, this commit fixes that too.
---
 sv.c       |  4 ++--
 t/op/tie.t | 10 ++++++++++
 2 files changed, 12 insertions(+), 2 deletions(-)

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}
-- 
2.7.4