8 require './test.pl'; require './charset_tools.pl';
9 unless ($has_perlio = find PerlIO::Layer 'perlio') {
11 # Since you don't have perlio you might get failures with UTF-8 locales.
18 no utf8; # Ironic, no?
22 # Think carefully before adding tests here. In general this should be
23 # used only for about three categories of tests:
25 # (1) tests that absolutely require 'use utf8', and since that in general
26 # shouldn't be needed as the utf8 is being obsoleted, this should
27 # have rather few tests. If you want to test Unicode and regexes,
28 # you probably want to go to op/regexp or op/pat; if you want to test
29 # split, go to op/split; pack, op/pack; appending or joining,
30 # op/append or op/join, and so forth
32 # (2) tests that have to do with Unicode tokenizing (though it's likely
33 # that all the other Unicode tests sprinkled around the t/**/*.t are
34 # going to catch that)
36 # (3) complicated tests that simultaneously stress so many Unicode features
37 # that deciding into which other test script the tests should go to
38 # is hard -- maybe consider breaking up the complicated test
43 # bug id 20001009.001 (#4409)
47 { use bytes; $a = byte_utf8a_to_utf8n("\xc3\xa4") }
48 { use utf8; $b = uni_to_native("\xe4") }
54 { use utf8; ok($a ne $b) }
59 # bug id 20000730.004 (#3599)
61 my $smiley = "\x{263a}";
63 for my $s ("\x{263a}",
72 my $length_chars = length($s);
74 { use bytes; $length_bytes = length($s) }
75 my @regex_chars = $s =~ m/(.)/g;
76 my $regex_chars = @regex_chars;
77 my @split_chars = split //, $s;
78 my $split_chars = @split_chars;
79 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
83 for my $s ("\x{263a}" . "\x{263a}",
92 my $length_chars = length($s);
94 { use bytes; $length_bytes = length($s) }
95 my @regex_chars = $s =~ m/(.)/g;
96 my $regex_chars = @regex_chars;
97 my @split_chars = split //, $s;
98 my $split_chars = @split_chars;
99 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
107 local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
108 my $x = eval q/"\\/ . "\x{100}" . q/"/;;
110 ok($w == 0 && $x eq "\x{100}");
117 $result .= '>' . join (',', map {ord} split //, $_) . '<'
123 eval $show or die $@; # We don't expect this sub definition to fail.
124 my $progfile = 'utf' . $$;
125 END {unlink_all $progfile}
127 # 64 is '@' in ASCII, ' ' in EBCDIC
128 # 193 is not punctuation in either ASCII nor EBCDIC
130 foreach (64, 193, 257, 65532) {
133 # I don't want to use map {ord} and I've no need to hardcode the UTF
135 my $charsubst = $char;
136 $charsubst =~ s/(.)/ord ($1) . ','/ge;
138 # Not testing this one against map {ord}
140 = join " . ", map {sprintf 'chr (%d)', ord $_} split //, $char;
141 push @char, [$_, $char, $charsubst, $char_as_ord];
143 # Now we've done all the UTF8 munching hopefully we're safe
145 ['check our detection program works',
146 'my @a = ("'.chr(64).'\x2A", ""); $b = show @a', qr/^>64,42<><$/],
147 ['check literal 8 bit input',
148 '$a = "' . chr (193) . '"; $b = show $a', qr/^>193<$/],
149 ['check no utf8; makes no change',
150 'no utf8; $a = "' . chr (193) . '"; $b = show $a', qr/^>193<$/],
151 # Now we do the real byte sequences that are valid UTF8
153 ["the utf8 sequence for chr $_->[0]",
154 qq{\$a = "$_->[1]"; \$b = show \$a}, qr/^>$_->[2]<$/],
155 ["no utf8; for the utf8 sequence for chr $_->[0]",
156 qq(no utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[2]<$/],
157 ["use utf8; for the utf8 sequence for chr $_->[0]",
158 qq(use utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[0]<$/],
160 # Interpolation of hex characters needs to take place now, as we're
161 # testing feeding malformed utf8 into perl. Bug now fixed was an
162 # "out of memory" error. We really need the "" [rather than qq()
163 # or q()] to get the best explosion.
164 ["!Feed malformed utf8 into perl.", <<"BANG",
165 use utf8; %a = ("\xE1\xA0"=>"sterling");
166 print 'start'; printf '%x,', ord \$_ foreach keys %a; print "end\n";
168 qr/^Malformed UTF-8 character \(\d bytes?, need \d, .+\).*start\d+,end$/sm
172 my ($why, $prog, $expect) = @$_;
173 open P, ">$progfile" or die "Can't open '$progfile': $!";
174 binmode(P, ":bytes") if $has_perlio;
175 print P $show, $prog, '; print $b'
176 or die "Print to 'progfile' failed: $!";
177 close P or die "Can't close '$progfile': $!";
178 if ($why =~ s/^!//) {
179 print "# Possible delay...\n";
183 my $result = runperl ( stderr => 1, progfile => $progfile );
184 like ($result, $expect, $why);
187 "# Again! Again! [but this time as eval, and not the explosive one]\n";
188 # and now we've safely done them all as separate files, check that the
189 # evals do the same thing. Hopefully doing it later successfully decouples
190 # the previous tests from anything messy that may go wrong with the evals.
192 my ($why, $prog, $expect) = @$_;
193 next if $why =~ m/^!/; # Goes bang.
194 my $result = eval $prog;
196 print "# prog is $prog\n";
197 print "# \$\@=", _qq($@), "\n";
199 like ($result, $expect, $why);
202 # See what the tokeniser does with hash keys.
203 print "# What does the tokeniser do with utf8 hash keys?\n";
205 # This is the control - I don't expect it to fail
206 ["assign utf8 for chr $_->[0] to a hash",
207 qq(my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
208 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
210 ["no utf8; assign utf8 for chr $_->[0] to a hash",
211 qq(no utf8; my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
212 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
214 ["use utf8; assign utf8 for chr $_->[0] to a hash",
215 qq(use utf8; my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
216 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
218 # Now check literal $h{"x"} constructions.
219 ["\$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
220 qq(my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
221 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
223 ["no utf8; \$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
224 qq(no utf8; my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
225 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
227 ["use utf8; \$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
228 qq(use utf8; my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
229 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
231 # Now check "x" => constructions.
232 ["assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
233 qq(my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
234 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
236 ["no utf8; assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
237 qq(no utf8; my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
238 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
240 ["use utf8; assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
241 qq(use utf8; my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
242 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
244 # Check copies of hashes made from literal utf8 keys
245 ["assign utf8 for chr $_->[0] to a hash, then copy it",
246 qq(my \$a = "$_->[1]"; my %i; \$i{\$a} = 1; my %h = %i;
247 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
249 ["no utf8; assign utf8 for chr $_->[0] to a hash, then copy it",
250 qq(no utf8; my \$a = "$_->[1]"; my %i; \$i{\$a} = 1;; my %h = %i;
251 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
253 ["use utf8; assign utf8 for chr $_->[0] to a hash, then copy it",
254 qq(use utf8; my \$a = "$_->[1]"; my %i; \$i{\$a} = 1; my %h = %i;
255 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
259 my ($why, $prog, $expect) = @$_;
261 my $result = eval $prog;
262 like ($result, $expect, $why);
267 # bug fixed by change #17928
268 # separate perl used because we rely on 'strict' not yet loaded;
269 # before the patch, the eval died with an error like:
270 # "my" variable $strict::VERSION can't be in a package
273 skip("Haven't bothered to port this to EBCDIC non-1047", 1) if $::IS_EBCDIC
276 ok('' eq runperl(prog => <<'CODE'), "change #17928");
277 my $code = qq{ my \$\xe3\x83\x95\xe3\x83\xbc = 5; };
286 ok('' eq runperl(prog => <<'CODE'), "change #17928");
287 my $code = qq{ my \$\xCE\x47\x64\xCE\x48\x70 = 5; };
300 0 ....... 1 ....... 2 ....... 3 ....... 4 ....... 5 ....... 6 ....... 7 .......
305 push @i, $s = index($a, '6'); # 60
306 push @i, $s = index($a, '.', $s); # next . after 60 is 62
307 push @i, $s = index($a, '5'); # 50
308 push @i, $s = index($a, '.', $s); # next . after 52 is 52
309 push @i, $s = index($a, '7'); # 70
310 push @i, $s = index($a, '.', $s); # next . after 70 is 72
311 push @i, $s = index($a, '4'); # 40
312 push @i, $s = index($a, '.', $s); # next . after 40 is 42
313 is("@i", "60 62 50 52 70 72 40 42", "utf8 heredoc index");
316 push @i, $s = rindex($a, '6'); # 60
317 push @i, $s = rindex($a, '.', $s); # previous . before 60 is 58
318 push @i, $s = rindex($a, '5'); # 50
319 push @i, $s = rindex($a, '.', $s); # previous . before 52 is 48
320 push @i, $s = rindex($a, '7'); # 70
321 push @i, $s = rindex($a, '.', $s); # previous . before 70 is 68
322 push @i, $s = rindex($a, '4'); # 40
323 push @i, $s = rindex($a, '.', $s); # previous . before 40 is 38
324 is("@i", "60 58 50 48 70 68 40 38", "utf8 heredoc rindex");
327 push @i, $s = index($a, '6'); # 60
328 push @i, index($a, '.', $s); # next . after 60 is 62
329 push @i, rindex($a, '.', $s); # previous . before 60 is 58
330 push @i, $s = rindex($a, '5'); # 60
331 push @i, index($a, '.', $s); # next . after 50 is 52
332 push @i, rindex($a, '.', $s); # previous . before 50 is 48
333 push @i, $s = index($a, '7', $s); # 70
334 push @i, index($a, '.', $s); # next . after 70 is 72
335 push @i, rindex($a, '.', $s); # previous . before 70 is 68
336 is("@i", "60 62 58 50 52 48 70 72 68", "utf8 heredoc index and rindex");
340 skip("Haven't bothered to port this to EBCDIC non-1047", 1) if $::IS_EBCDIC
344 is eval qq{q \xc3\xbc test \xc3\xbc . qq\xc2\xb7 test \xc2\xb7},
346 "utf8 quote delimiters [perl #16823]";
349 is eval qq{q \x8B\x70 test \x8B\x70 . qq\x80\x66 test \x80\x66},
351 "utf8 quote delimiters [perl #16823]";
355 # Test the "internals".
360 my $c = chr(0x0DF); # FF is invariant in many EBCDIC pages, so is not a
361 # fair test of 'beyond'; but DF is variant (in all
362 # supported EBCDIC pages so far), so make 2 'beyond'
366 ok( utf8::valid($a), "utf8::valid basic");
367 ok( utf8::valid($b), "utf8::valid beyond");
368 ok( utf8::valid($c), "utf8::valid beyond");
369 ok( utf8::valid($d), "utf8::valid unicode");
371 ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
372 ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
373 ok(!utf8::is_utf8($c), "!utf8::is_utf8 beyond");
374 ok( utf8::is_utf8($d), "utf8::is_utf8 unicode");
376 is(utf8::upgrade($a), 1, "utf8::upgrade basic");
377 if ($::IS_EBCDIC) { # EBCDIC.
378 is(utf8::upgrade($b), 1, "utf8::upgrade beyond");
380 is(utf8::upgrade($b), 2, "utf8::upgrade beyond");
382 is(utf8::upgrade($c), 2, "utf8::upgrade beyond");
383 is(utf8::upgrade($d), 2, "utf8::upgrade unicode");
385 is($a, "A", "basic");
386 is($b, "\xFF", "beyond");
387 is($c, "\xDF", "beyond");
388 is($d, "\x{100}", "unicode");
390 ok( utf8::valid($a), "utf8::valid basic");
391 ok( utf8::valid($b), "utf8::valid beyond");
392 ok( utf8::valid($c), "utf8::valid beyond");
393 ok( utf8::valid($d), "utf8::valid unicode");
395 ok( utf8::is_utf8($a), "utf8::is_utf8 basic");
396 ok( utf8::is_utf8($b), "utf8::is_utf8 beyond");
397 ok( utf8::is_utf8($c), "utf8::is_utf8 beyond");
398 ok( utf8::is_utf8($d), "utf8::is_utf8 unicode");
400 is(utf8::downgrade($a), 1, "utf8::downgrade basic");
401 is(utf8::downgrade($b), 1, "utf8::downgrade beyond");
402 is(utf8::downgrade($c), 1, "utf8::downgrade beyond");
404 is($a, "A", "basic");
405 is($b, "\xFF", "beyond");
406 is($c, "\xDF", "beyond");
408 ok( utf8::valid($a), "utf8::valid basic");
409 ok( utf8::valid($b), "utf8::valid beyond");
410 ok( utf8::valid($c), "utf8::valid beyond");
412 ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
413 ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
414 ok(!utf8::is_utf8($c), "!utf8::is_utf8 beyond");
421 is($a, "A", "basic");
422 if ($::IS_EBCDIC) { # EBCDIC.
423 is(length($b), 1, "beyond length");
425 is(length($b), 2, "beyond length");
427 is(length($c), 2, "beyond length");
428 is(length($d), 2, "unicode length");
430 ok(utf8::valid($a), "utf8::valid basic");
431 ok(utf8::valid($b), "utf8::valid beyond");
432 ok(utf8::valid($c), "utf8::valid beyond");
433 ok(utf8::valid($d), "utf8::valid unicode");
435 # encode() clears the UTF-8 flag (unlike upgrade()).
436 ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
437 ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
438 ok(!utf8::is_utf8($c), "!utf8::is_utf8 beyond");
439 ok(!utf8::is_utf8($d), "!utf8::is_utf8 unicode");
446 is($a, "A", "basic");
447 is($b, "\xFF", "beyond");
448 is($c, "\xDF", "beyond");
449 is($d, "\x{100}", "unicode");
451 ok(utf8::valid($a), "!utf8::valid basic");
452 ok(utf8::valid($b), "!utf8::valid beyond");
453 ok(utf8::valid($c), "!utf8::valid beyond");
454 ok(utf8::valid($d), " utf8::valid unicode");
456 ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
457 if ($::IS_EBCDIC) { # EBCDIC.
458 ok( utf8::is_utf8(pack('U',0x0ff)), " utf8::is_utf8 beyond");
460 ok( utf8::is_utf8($b), " utf8::is_utf8 beyond"); # $b stays in UTF-8.
462 ok( utf8::is_utf8($c), " utf8::is_utf8 beyond"); # $c stays in UTF-8.
463 ok( utf8::is_utf8($d), " utf8::is_utf8 unicode");
467 eval {utf8::encode("£")};
468 like($@, qr/^Modification of a read-only value attempted/,
469 "utf8::encode should refuse to touch read-only values");
473 # Make sure utf8::decode respects copy-on-write [perl #91834].
474 # Hash keys are the easiest way to test this.
475 my $name = byte_utf8a_to_utf8n("\x{c3}\x{b3}");
476 my ($k1) = keys %{ { $name=>undef } };
480 my $h = { $k1 => 1, $k2 => 2 };
481 is join('', keys %$h), $k2, 'utf8::decode respects copy-on-write';
485 # Make sure utf8::decode does not modify read-only scalars
488 my $name = byte_utf8a_to_utf8n("\x{c3}\x{b3}");
489 Internals::SvREADONLY($name, 1);
490 eval { utf8::decode($name) };
491 like $@, qr/^Modification of a read-only/,
492 'utf8::decode respects readonliness';
496 # utf8::decode should stringify refs [perl #91852].
498 package eieifg { use overload '""' => sub { main::byte_utf8a_to_utf8n("\x{c3}\x{b3}") },
501 my $name = bless[], eieifg::;
503 is $name, uni_to_native("\xf3"), 'utf8::decode flattens references';
507 # What do the utf8::* functions do when given a reference? A test
508 # for a behavior change that made this start dying as of
509 # v5.15.6-407-gc710240 due to a fix for [perl #91852]:
511 # ./miniperl -Ilib -wle 'use strict; print $]; my $s = shift; my $s_ref = \$s; utf8::decode($s_ref); print $$s_ref' hlagh
513 'utf8::is_utf8' => { returns => "hlagh" },
514 'utf8::valid' => { returns => "hlagh" },
515 'utf8::encode' => { error => qr/Can't use string .*? as a SCALAR ref/},
516 'utf8::decode' => { error => qr/Can't use string .*? as a SCALAR ref/},
517 'utf8::upgrade' => { error => qr/Can't use string .*? as a SCALAR ref/ },
518 'utf8::downgrade' => { returns => "hlagh" },
519 'utf8::native_to_unicode' => { returns => "hlagh" },
520 'utf8::unicode_to_native' => { returns => "hlagh" },
522 for my $func (sort keys %expected) { # sort just so it's deterministic wrt diffing *.t output
523 my $code = sprintf q[
530 my $ret = eval $code or my $error = $@;
531 if (my $error_rx = $expected{$func}->{error}) {
532 if (defined $error) {
533 like $error, $error_rx, "The $func function should die with an error matching $error_rx";
535 fail("We were expecting an error when calling the $func function but got a value of '$ret' instead");
537 } elsif (my $returns = $expected{$func}->{returns}) {
538 is($ret, $returns, "The $func function lives and returns '$returns' as expected");
540 die "PANIC: Internal Error"
546 my $a = "456" . uni_to_native("\xb6");
549 my $b = "123456" . uni_to_native("\xb6");
552 is($b, $a, "utf8::upgrade OffsetOK");
556 fresh_perl_like ('use utf8; utf8::moo()',
557 qr/Undefined subroutine utf8::moo/, {stderr=>1},
558 "Check Carp is loaded for AUTOLOADing errors")
562 # failure of is_utf8_char() without NATIVE_TO_UTF on EBCDIC (0260..027F)
563 ok(utf8::valid(chr(0x250)), "0x250");
564 ok(utf8::valid(chr(0x260)), "0x260");
565 ok(utf8::valid(chr(0x270)), "0x270");
566 ok(utf8::valid(chr(0x280)), "0x280");
571 ok( !utf8::is_utf8( "asd" ), "Wasteful format - qq{}" );
572 ok( !utf8::is_utf8( 'asd' ), "Wasteful format - q{}" );
573 ok( !utf8::is_utf8( qw(asd) ), "Wasteful format - qw{}" );
574 ok( !utf8::is_utf8( (asd => 1)[0] ), "Wasteful format - =>" );
575 ok( !utf8::is_utf8( -asd ), "Wasteful format - -word" );
576 no warnings 'bareword';
577 ok( !utf8::is_utf8( asd:: ), "Wasteful format - word::" );
578 no warnings 'reserved';
580 ok( !utf8::is_utf8( asd ), "Wasteful format - bareword" );
585 (undef, 0x7F, 0x7FF, 0xFFFF, 0x1FFFFF, 0x3FFFFFF, 0x7FFFFFFF);
587 (undef, undef, 0x40, 0x1000, 0x40000, 0x1000000, 0x40000000);
589 foreach my $length (6, 5, 4, 3, 2) {
590 my $high = $highest[$length];
591 while ($high > $highest[$length - 1]) {
592 my $low = $high - $step[$length] + 1;
593 $low = $highest[$length - 1] + 1 if $low <= $highest[$length - 1];
594 ok(utf8::valid(do {no warnings 'utf8'; chr $low}),
595 sprintf "chr %x, length $length is valid", $low);
596 ok(utf8::valid(do {no warnings 'utf8'; chr $high}),
597 sprintf "chr %x, length $length is valid", $high);
598 $high -= $step[$length];
603 # #80190 update pos, and cached length/position-mapping after
604 # utf8 upgrade/downgrade, encode/decode
609 my $utf8_bytes = byte_utf8a_to_utf8n("\xc8\x81\xe3\xbf\xbf");
610 my $s = "A$utf8_bytes\x{100}";
615 is(length($s), 6, "(pos $pos) len before utf8::downgrade");
616 is(pos($s), $pos, "(pos $pos) pos before utf8::downgrade");
618 is(length($s), 6, "(pos $pos) len after utf8::downgrade");
619 is(pos($s), $pos, "(pos $pos) pos after utf8::downgrade");
620 is($s, "A$utf8_bytes","(pos $pos) str after utf8::downgrade");
622 is(length($s), 3, "(pos $pos) len after D; utf8::decode");
623 is(pos($s), undef, "(pos $pos) pos after D; utf8::decode");
624 is($s, "A\x{201}\x{3fff}", "(pos $pos) str after D; utf8::decode");
626 is(length($s), 6, "(pos $pos) len after D; utf8::encode");
627 is(pos($s), undef, "(pos $pos) pos after D; utf8::encode");
628 is($s, "A$utf8_bytes","(pos $pos) str after D; utf8::encode");
633 is(length($s), 6, "(pos $pos) len before utf8::upgrade");
634 is(pos($s), $pos, "(pos $pos) pos before utf8::upgrade");
636 is(length($s), 6, "(pos $pos) len after utf8::upgrade");
637 is(pos($s), $pos, "(pos $pos) pos after utf8::upgrade");
638 is($s, "A$utf8_bytes","(pos $pos) str after utf8::upgrade");
640 is(length($s), 3, "(pos $pos) len after U; utf8::decode");
641 is(pos($s), undef, "(pos $pos) pos after U; utf8::decode");
642 is($s, "A\x{201}\x{3fff}", "(pos $pos) str after U; utf8::decode");
644 is(length($s), 6, "(pos $pos) len after U; utf8::encode");
645 is(pos($s), undef, "(pos $pos) pos after U; utf8::encode");
646 is($s, "A$utf8_bytes","(pos $pos) str after U; utf8::encode");
650 skip("Test only valid on ASCII platform", 1) unless $::IS_ASCII;
652 skip("Test needs a B module, which is lacking in this Perl", 1)
653 if $Config::Config{'extensions'} !~ /\bB\b/;
655 my $out = runperl ( switches => ["-XMO=Concise"],
656 prog => 'utf8::unicode_to_native(0x41);
657 utf8::native_to_unicode(0x42)',
659 unlike($out, qr/entersub/,
660 "utf8::unicode_to_native() and native_to_unicode() optimized out");
664 # [perl #119043] utf8::upgrade should not croak on read-only COWs
666 eval { utf8::upgrade($_) };
667 is $@, "", 'no error with utf8::upgrade on read-only COW';
669 # This one croaks, but not because the scalar is read-only
670 eval "package \x{100};\n" . <<'END'
672 eval { utf8::downgrade($_) };
673 ::like $@, qr/^Wide character/,
674 'right error with utf8::downgrade on read-only COW';