Don’t allow read-only COWs to be blessed

The logic exempting copy-on-write scalars from read-only checks in
sv_bless was left over from when READONLY+FAKE meant copy-on-write.

diff --git a/sv.c b/sv.c
index d6fffa6..44842fe 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9796,7 +9796,7 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
         Perl_croak(aTHX_ "Can't bless non-reference value");
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
-       if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
+       if (SvREADONLY(tmpRef))
            Perl_croak_no_modify();
        if (SvOBJECT(tmpRef)) {
            SvREFCNT_dec(SvSTASH(tmpRef));

diff --git a/t/op/bless.t b/t/op/bless.t
index 801e985..9d39326 100644 (file)
--- a/t/op/bless.t
+++ b/t/op/bless.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (110);
+plan (111);
 
 sub expected {
     my($object, $package, $type) = @_;
@@ -148,3 +148,9 @@ delete $::{"_117941::"};
 eval { _117941() };
 like $@, qr/^Attempt to bless into a freed package at /,
         'bless with one arg when current stash is freed';
+
+for(__PACKAGE__) {
+    eval { bless \$_ };
+    like $@, qr/^Modification of a read-only value attempted/,
+         'read-only COWs cannot be blessed';
+}