diff options
| -rw-r--r-- | lib/utf8.t | 8 | ||||
| -rw-r--r-- | sv.c | 8 | ||||
| -rw-r--r-- | t/op/utfhash.t | 9 |
3 files changed, 19 insertions, 6 deletions
diff --git a/lib/utf8.t b/lib/utf8.t index 33cd5966af..90035e56b3 100644 --- a/lib/utf8.t +++ b/lib/utf8.t @@ -37,7 +37,7 @@ no utf8; # Ironic, no? # # -plan tests => 143; +plan tests => 144; { # bug id 20001009.001 @@ -409,3 +409,9 @@ SKIP: { ok( utf8::is_utf8($b), " utf8::is_utf8 beyond"); # $b stays in UTF-8. ok( utf8::is_utf8($c), " utf8::is_utf8 unicode"); } + +{ + eval {utf8::encode("£")}; + like($@, qr/^Modification of a read-only value attempted/, + "utf8::encode should refuse to touch read-only values"); +} @@ -3470,12 +3470,16 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags) return len; } + if (SvUTF8(sv)) + return SvCUR(sv); + if (SvIsCOW(sv)) { sv_force_normal_flags(sv, 0); } - if (SvUTF8(sv)) - return SvCUR(sv); + if (SvREADONLY(sv)) { + Perl_croak(aTHX_ PL_no_modify); + } if (PL_encoding && !(flags & SV_UTF8_NO_ENCODING)) sv_recode_to_utf8(sv, PL_encoding); diff --git a/t/op/utfhash.t b/t/op/utfhash.t index 9e0196b6b8..33909c0cbc 100644 --- a/t/op/utfhash.t +++ b/t/op/utfhash.t @@ -32,8 +32,9 @@ is($hashu{"\xff"},0xFF); is($hashu{"\x7f"},0x7F); # Now try same thing with variables forced into various forms. -foreach my $a ("\x7f","\xff") +foreach ("\x7f","\xff") { + my $a = $_; # Force a copy utf8::upgrade($a); is($hash8{$a},ord($a)); is($hashu{$a},ord($a)); @@ -56,8 +57,9 @@ $hash8{chr(0x1ff)} = 0x1ff; # Check we have not got an spurious extra keys is(join('',sort { ord $a <=> ord $b } keys %hash8),"\x7f\xff\x{1ff}"); -foreach my $a ("\x7f","\xff","\x{1ff}") +foreach ("\x7f","\xff","\x{1ff}") { + my $a = $_; utf8::upgrade($a); is($hash8{$a},ord($a)); my $b = $a.chr(100); @@ -69,8 +71,9 @@ foreach my $a ("\x7f","\xff","\x{1ff}") is(delete $hashu{chr(0x1ff)},0x1ff); is(join('',sort keys %hashu),"\x7f\xff"); -foreach my $a ("\x7f","\xff") +foreach ("\x7f","\xff") { + my $a = $_; utf8::upgrade($a); is($hashu{$a},ord($a)); utf8::downgrade($a); |