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 (file)
--- 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 (file)
--- 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}