Read-only COWs should not be exempt from s/// croaking

$  ./miniperl -Ilib -e 'for(__PACKAGE__) { s/a/a/ }'
Modification of a read-only value attempted at -e line 1.
$  ./miniperl -Ilib -e 'for(__PACKAGE__) { s/b/b/ }'
$  ./miniperl -Ilib -e 'for("main") { s/a/a/ }'
Modification of a read-only value attempted at -e line 1.
$  ./miniperl -Ilib -e 'for("main") { s/b/b/ }'
Modification of a read-only value attempted at -e line 1.

When I pass the constant "main" to s///, it croaks whether the regular
expression matches or not.

When I pass __PACKAGE__, which has the same content and is also read-
only, it only croaks when the pattern matches.

This commit removes some logic that is left over from when
READONLY+FAKE meant copy-on-write.  Read-only does mean read-only now,
so copy-on-write scalars should not be exempt from read-only checks.

diff --git a/pp_hot.c b/pp_hot.c
index 5010606..3adeb1e 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2058,9 +2058,6 @@ PP(pp_subst)
        sv_force_normal_flags(TARG,0);
 #endif
     if (!(rpm->op_pmflags & PMf_NONDESTRUCT)
-#ifdef PERL_ANY_COW
-       && !is_cow
-#endif
        && (SvREADONLY(TARG)
            || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
                  || SvTYPE(TARG) > SVt_PVLV)

diff --git a/t/re/subst.t b/t/re/subst.t
index 912dacc..d4e9367 100644 (file)
--- a/t/re/subst.t
+++ b/t/re/subst.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 235 );
+plan( tests => 236 );
 
 $_ = 'david';
 $a = s/david/rules/r;
@@ -995,3 +995,10 @@ delete $::{does_not_exist}; # just in case
 eval { no warnings; $::{does_not_exist}=~s/(?:)/*{"does_not_exist"}; 4/e };
 like $@, qr/^Modification of a read-only value/,
     'vivifying stash elem in $that::{elem} =~ s//.../e';
+
+# COWs should not be exempt from read-only checks.  s/// croaks on read-
+# only values even when the pattern does not match, but it was not doing so
+# for COWs.
+eval { for (__PACKAGE__) { s/b/c/; } };
+like $@, qr/^Modification of a read-only value/,
+    'read-only COW =~ s/does not match// should croak';