op.c:ck_svconst: Don’t allow ro COWs under old COW

Under PERL_OLD_COPY_ON_WRITE, allowing COWs to become read-only will
complicate things elsewhere.  It uses the IV slot of an SV to point
to a loop of SVs sharing the same buffer.  sv_2iv cannot cache the IV
without running the SV through sv_force_normal, but that will croak on
read-only values.  I could change it to S_sv_uncow, but there are more
cases elsewhere that would have to be audited, I don’t think it’s
worth spending time on improving PERL_OLD_COPY_ON_WRITE as it’s ‘dead
code, never intended to go live’ according to its author.  I am
bothering with at least this much because I don’t want to break it
knowingly.

diff --git a/lib/utf8.t b/lib/utf8.t
index e6c94e6..3978187 100644 (file)
--- a/lib/utf8.t
+++ b/lib/utf8.t
@@ -565,17 +565,8 @@ for my $pos (0..5) {
 
 # [perl #119043] utf8::upgrade should not croak on read-only COWs
 for(__PACKAGE__) {
 
 # [perl #119043] utf8::upgrade should not croak on read-only COWs
 for(__PACKAGE__) {

-    # First make sure we have a COW, otherwise this test is useless.
-    my $copy = $_;
-    my @addrs = unpack "L!L!", pack "pp", $copy, $_;
-    if ($addrs[0] != $addrs[1]) {
-       fail("__PACKAGE__ did not produce a COW - if this change was "
-           ."intentional, please provide me with another ro COW scalar")
-    }
-    else {

        eval { utf8::upgrade($_) };
        is $@, "", 'no error with utf8::upgrade on read-only COW';
        eval { utf8::upgrade($_) };
        is $@, "", 'no error with utf8::upgrade on read-only COW';

-    }

 }
 # This one croaks, but not because the scalar is read-only
 eval "package \x{100};\n" . <<'END'
 }
 # This one croaks, but not because the scalar is read-only
 eval "package \x{100};\n" . <<'END'

diff --git a/op.c b/op.c
index fc0f130..a209110 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10558,6 +10558,9 @@ Perl_ck_svconst(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_SVCONST;
     PERL_UNUSED_CONTEXT;
 {
     PERL_ARGS_ASSERT_CK_SVCONST;
     PERL_UNUSED_CONTEXT;

+#ifdef PERL_OLD_COPY_ON_WRITE
+    if (SvIsCOW(cSVOPo->op_sv)) sv_force_normal(cSVOPo->op_sv);
+#endif

     SvREADONLY_on(cSVOPo->op_sv);
     return o;
 }
     SvREADONLY_on(cSVOPo->op_sv);
     return o;
 }