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

[perl5.git] / lib / utf8.t

diff --git a/lib/utf8.t b/lib/utf8.t
index 76ab7df..3978187 100644 (file)
--- a/lib/utf8.t
+++ b/lib/utf8.t
@@ -450,7 +450,7 @@ SKIP: {
 }
 
 {
-    # utf8::decode should stringify refs [perl #91850].
+    # utf8::decode should stringify refs [perl #91852].
 
     package eieifg { use overload '""'      => sub { "\x{c3}\x{b3}" },
                                    fallback => 1 }
@@ -523,9 +523,6 @@ SKIP: {
 
 for my $pos (0..5) {
 
-    my $pos1 = ($pos >= 3)  ? 2 : ($pos >= 1) ? 1 : 0;
-    my $pos2 = ($pos1 == 2) ? 3 : $pos1;
-
     my $p;
     my $s = "A\xc8\x81\xe8\xab\x86\x{100}";
     chop($s);
@@ -540,11 +537,11 @@ for my $pos (0..5) {
     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after     utf8::downgrade");
     utf8::decode($s);
     is(length($s), 3,             "(pos $pos) len after  D; utf8::decode");
-    is(pos($s),    $pos1,         "(pos $pos) pos after  D; utf8::decode");
+    is(pos($s),    undef,         "(pos $pos) pos after  D; utf8::decode");
     is($s, "A\x{201}\x{8ac6}",    "(pos $pos) str after  D; utf8::decode");
     utf8::encode($s);
     is(length($s), 6,             "(pos $pos) len after  D; utf8::encode");
-    is(pos($s),    $pos2,         "(pos $pos) pos after  D; utf8::encode");
+    is(pos($s),    undef,         "(pos $pos) pos after  D; utf8::encode");
     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after  D; utf8::encode");
 
     $s = "A\xc8\x81\xe8\xab\x86";
@@ -558,12 +555,28 @@ for my $pos (0..5) {
     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after     utf8::upgrade");
     utf8::decode($s);
     is(length($s), 3,             "(pos $pos) len after  U; utf8::decode");
-    is(pos($s),    $pos1,         "(pos $pos) pos after  U; utf8::decode");
+    is(pos($s),    undef,         "(pos $pos) pos after  U; utf8::decode");
     is($s, "A\x{201}\x{8ac6}",    "(pos $pos) str after  U; utf8::decode");
     utf8::encode($s);
     is(length($s), 6,             "(pos $pos) len after  U; utf8::encode");
-    is(pos($s),    $pos2,         "(pos $pos) pos after  U; utf8::encode");
+    is(pos($s),    undef,         "(pos $pos) pos after  U; utf8::encode");
     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after  U; utf8::encode");
 }
 
+# [perl #119043] utf8::upgrade should not croak on read-only COWs
+for(__PACKAGE__) {
+       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'
+    for(__PACKAGE__) {
+       eval { utf8::downgrade($_) };
+       ::like $@, qr/^Wide character/,
+           'right error with utf8::downgrade on read-only COW';
+    }
+    1
+END
+or die $@;
+
 done_testing();