lib/utf8.t

   1 #!./perl
   2
   3 my $has_perlio;
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8     require './test.pl';
   9     unless ($has_perlio = find PerlIO::Layer 'perlio') {
  10         print <<EOF;
  11 # Since you don't have perlio you might get failures with UTF-8 locales.
  12 EOF
  13     }
  14 }
  15
  16 use strict;
  17 use warnings;
  18 no utf8; # Ironic, no?
  19
  20 # NOTE!
  21 #
  22 # Think carefully before adding tests here.  In general this should be
  23 # used only for about three categories of tests:
  24 #
  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
  31 #
  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)
  35 #
  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
  39 #
  40 #
  41
  42 {
  43     # bug id 20001009.001
  44
  45     my ($a, $b);
  46
  47     { use bytes; $a = "\xc3\xa4" }
  48     { use utf8;  $b = "\xe4"     }
  49
  50     my $test = 68;
  51
  52     ok($a ne $b);
  53
  54     { use utf8; ok($a ne $b) }
  55 }
  56
  57
  58 {
  59     # bug id 20000730.004
  60
  61     my $smiley = "\x{263a}";
  62
  63     for my $s ("\x{263a}",
  64                $smiley,
  65
  66                "" . $smiley,
  67                "" . "\x{263a}",
  68
  69                $smiley    . "",
  70                "\x{263a}" . "",
  71                ) {
  72         my $length_chars = length($s);
  73         my $length_bytes;
  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
  80            "1/1/1/3");
  81     }
  82
  83     for my $s ("\x{263a}" . "\x{263a}",
  84                $smiley    . $smiley,
  85
  86                "\x{263a}\x{263a}",
  87                "$smiley$smiley",
  88
  89                "\x{263a}" x 2,
  90                $smiley    x 2,
  91                ) {
  92         my $length_chars = length($s);
  93         my $length_bytes;
  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
 100            "2/2/2/6");
 101     }
 102 }
 103
 104
 105 {
 106     my $w = 0;
 107     local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
 108     my $x = eval q/"\\/ . "\x{100}" . q/"/;;
 109
 110     ok($w == 0 && $x eq "\x{100}");
 111 }
 112
 113 {
 114     my $show = q(
 115                  sub show {
 116                    my $result;
 117                    $result .= '>' . join (',', map {ord} split //, $_) . '<'
 118                      foreach @_;
 119                    $result;
 120                  }
 121                  1;
 122                 );
 123     eval $show or die $@; # We don't expect this sub definition to fail.
 124     my $progfile = 'utf' . $$;
 125     END {unlink_all $progfile}
 126
 127     # If I'm right 60 is '>' in ASCII, ' ' in EBCDIC
 128     # 173 is not punctuation in either ASCII or EBCDIC
 129     my (@char);
 130     foreach (60, 173, 257, 65532) {
 131       my $char = chr $_;
 132       utf8::encode($char);
 133       # I don't want to use map {ord} and I've no need to hardcode the UTF
 134       # version
 135       my $charsubst = $char;
 136       $charsubst =~ s/(.)/ord ($1) . ','/ge;
 137       chop $charsubst;
 138       # Not testing this one against map {ord}
 139       my $char_as_ord
 140           = join " . ", map {sprintf 'chr (%d)', ord $_} split //, $char;
 141       push @char, [$_, $char, $charsubst, $char_as_ord];
 142     }
 143     # Now we've done all the UTF8 munching hopefully we're safe
 144     my @tests = (
 145              ['check our detection program works',
 146               'my @a = ("'.chr(60).'\x2A", ""); $b = show @a', qr/^>60,42<><$/],
 147              ['check literal 8 bit input',
 148               '$a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
 149              ['check no utf8; makes no change',
 150               'no utf8; $a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
 151              # Now we do the real byte sequences that are valid UTF8
 152              (map {
 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]<$/],
 159               } @char),
 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";
 167 BANG
 168               qr/^Malformed UTF-8 character \(\d bytes?, need \d, .+\).*start\d+,end$/sm
 169              ],
 170             );
 171     foreach (@tests) {
 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";
 180         } else {
 181             print "# $prog\n";
 182         }
 183         my $result = runperl ( stderr => 1, progfile => $progfile );
 184         like ($result, $expect, $why);
 185     }
 186     print
 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.
 191     foreach (@tests) {
 192         my ($why, $prog, $expect) = @$_;
 193         next if $why =~ m/^!/; # Goes bang.
 194         my $result = eval $prog;
 195         if ($@) {
 196             print "# prog is $prog\n";
 197             print "# \$\@=", _qq($@), "\n";
 198         }
 199         like ($result, $expect, $why);
 200     }
 201
 202     # See what the tokeniser does with hash keys.
 203     print "# What does the tokeniser do with utf8 hash keys?\n";
 204     @tests = (map {
 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),
 209          qr/^>$_->[2]<$/],
 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),
 213          qr/^>$_->[2]<$/],
 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),
 217          qr/^>$_->[0]<$/],
 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),
 222          qr/^>$_->[2]<$/],
 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),
 226          qr/^>$_->[2]<$/],
 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),
 230          qr/^>$_->[0]<$/],
 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),
 235          qr/^>$_->[2]<$/],
 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),
 239          qr/^>$_->[2]<$/],
 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),
 243          qr/^>$_->[0]<$/],
 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),
 248          qr/^>$_->[2]<$/],
 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),
 252          qr/^>$_->[2]<$/],
 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),
 256          qr/^>$_->[0]<$/],
 257      } @char);
 258     foreach (@tests) {
 259         my ($why, $prog, $expect) = @$_;
 260         # print "# $prog\n";
 261         my $result = eval $prog;
 262         like ($result, $expect, $why);
 263     }
 264 }
 265
 266 #
 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
 271 #
 272 SKIP: {
 273     skip("Embedded UTF-8 does not work in EBCDIC", 1) if ord("A") == 193;
 274     ok('' eq runperl(prog => <<'CODE'), "change #17928");
 275         my $code = qq{ my \$\xe3\x83\x95\xe3\x83\xbc = 5; };
 276     {
 277         use utf8;
 278         eval $code;
 279         print $@ if $@;
 280     }
 281 CODE
 282 }
 283
 284 {
 285     use utf8;
 286     $a = <<'END';
 287 0 ....... 1 ....... 2 ....... 3 ....... 4 ....... 5 ....... 6 ....... 7 .......
 288 END
 289     my (@i, $s);
 290
 291     @i = ();
 292     push @i, $s = index($a, '6');     # 60
 293     push @i, $s = index($a, '.', $s); # next . after 60 is 62
 294     push @i, $s = index($a, '5');     # 50
 295     push @i, $s = index($a, '.', $s); # next . after 52 is 52
 296     push @i, $s = index($a, '7');     # 70
 297     push @i, $s = index($a, '.', $s); # next . after 70 is 72
 298     push @i, $s = index($a, '4');     # 40
 299     push @i, $s = index($a, '.', $s); # next . after 40 is 42
 300     is("@i", "60 62 50 52 70 72 40 42", "utf8 heredoc index");
 301
 302     @i = ();
 303     push @i, $s = rindex($a, '6');     # 60
 304     push @i, $s = rindex($a, '.', $s); # previous . before 60 is 58
 305     push @i, $s = rindex($a, '5');     # 50
 306     push @i, $s = rindex($a, '.', $s); # previous . before 52 is 48
 307     push @i, $s = rindex($a, '7');     # 70
 308     push @i, $s = rindex($a, '.', $s); # previous . before 70 is 68
 309     push @i, $s = rindex($a, '4');     # 40
 310     push @i, $s = rindex($a, '.', $s); # previous . before 40 is 38
 311     is("@i", "60 58 50 48 70 68 40 38", "utf8 heredoc rindex");
 312
 313     @i = ();
 314     push @i, $s =  index($a, '6');     # 60
 315     push @i,  index($a, '.', $s);      # next     . after  60 is 62
 316     push @i, rindex($a, '.', $s);      # previous . before 60 is 58
 317     push @i, $s = rindex($a, '5');     # 60
 318     push @i,  index($a, '.', $s);      # next     . after  50 is 52
 319     push @i, rindex($a, '.', $s);      # previous . before 50 is 48
 320     push @i, $s =  index($a, '7', $s); # 70
 321     push @i,  index($a, '.', $s);      # next     . after  70 is 72
 322     push @i, rindex($a, '.', $s);      # previous . before 70 is 68
 323     is("@i", "60 62 58 50 52 48 70 72 68", "utf8 heredoc index and rindex");
 324 }
 325
 326 SKIP: {
 327     skip("Embedded UTF-8 does not work in EBCDIC", 1) if ord("A") == 193;
 328     use utf8;
 329     is eval qq{q \xc3\xbc test \xc3\xbc . qq\xc2\xb7 test \xc2\xb7},
 330       ' test  test ',
 331       "utf8 quote delimiters [perl #16823]";
 332 }
 333
 334 # Test the "internals".
 335
 336 {
 337     my $a = "A";
 338     my $b = chr(0x0FF);
 339     my $c = chr(0x100);
 340
 341     ok( utf8::valid($a), "utf8::valid basic");
 342     ok( utf8::valid($b), "utf8::valid beyond");
 343     ok( utf8::valid($c), "utf8::valid unicode");
 344
 345     ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
 346     ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
 347     ok( utf8::is_utf8($c), "utf8::is_utf8 unicode");
 348
 349     is(utf8::upgrade($a), 1, "utf8::upgrade basic");
 350     if (ord('A') == 193) { # EBCDIC.
 351         is(utf8::upgrade($b), 1, "utf8::upgrade beyond");
 352     } else {
 353         is(utf8::upgrade($b), 2, "utf8::upgrade beyond");
 354     }
 355     is(utf8::upgrade($c), 2, "utf8::upgrade unicode");
 356
 357     is($a, "A",       "basic");
 358     is($b, "\xFF",    "beyond");
 359     is($c, "\x{100}", "unicode");
 360
 361     ok( utf8::valid($a), "utf8::valid basic");
 362     ok( utf8::valid($b), "utf8::valid beyond");
 363     ok( utf8::valid($c), "utf8::valid unicode");
 364
 365     ok( utf8::is_utf8($a), "utf8::is_utf8 basic");
 366     ok( utf8::is_utf8($b), "utf8::is_utf8 beyond");
 367     ok( utf8::is_utf8($c), "utf8::is_utf8 unicode");
 368
 369     is(utf8::downgrade($a), 1, "utf8::downgrade basic");
 370     is(utf8::downgrade($b), 1, "utf8::downgrade beyond");
 371
 372     is($a, "A",       "basic");
 373     is($b, "\xFF",    "beyond");
 374
 375     ok( utf8::valid($a), "utf8::valid basic");
 376     ok( utf8::valid($b), "utf8::valid beyond");
 377
 378     ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
 379     ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
 380
 381     utf8::encode($a);
 382     utf8::encode($b);
 383     utf8::encode($c);
 384
 385     is($a, "A",       "basic");
 386     if (ord('A') == 193) { # EBCDIC.
 387         is(length($b), 1, "beyond length");
 388     } else {
 389         is(length($b), 2, "beyond length");
 390     }
 391     is(length($c), 2, "unicode length");
 392
 393     ok(utf8::valid($a), "utf8::valid basic");
 394     ok(utf8::valid($b), "utf8::valid beyond");
 395     ok(utf8::valid($c), "utf8::valid unicode");
 396
 397     # encode() clears the UTF-8 flag (unlike upgrade()).
 398     ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
 399     ok(!utf8::is_utf8($b), "!utf8::is_utf8 beyond");
 400     ok(!utf8::is_utf8($c), "!utf8::is_utf8 unicode");
 401
 402     utf8::decode($a);
 403     utf8::decode($b);
 404     utf8::decode($c);
 405
 406     is($a, "A",       "basic");
 407     is($b, "\xFF",    "beyond");
 408     is($c, "\x{100}", "unicode");
 409
 410     ok(utf8::valid($a), "!utf8::valid basic");
 411     ok(utf8::valid($b), "!utf8::valid beyond");
 412     ok(utf8::valid($c), " utf8::valid unicode");
 413
 414     ok(!utf8::is_utf8($a), "!utf8::is_utf8 basic");
 415     if (ord('A') == 193) { # EBCDIC.
 416         ok( utf8::is_utf8(pack('U',0x0ff)), " utf8::is_utf8 beyond");
 417     } else {
 418         ok( utf8::is_utf8($b), " utf8::is_utf8 beyond"); # $b stays in UTF-8.
 419     }
 420     ok( utf8::is_utf8($c), " utf8::is_utf8 unicode");
 421 }
 422
 423 {
 424     eval {utf8::encode("£")};
 425     like($@, qr/^Modification of a read-only value attempted/,
 426          "utf8::encode should refuse to touch read-only values");
 427 }
 428
 429 {
 430     my $a = "456\xb6";
 431     utf8::upgrade($a);
 432
 433     my $b = "123456\xb6";
 434     $b =~ s/^...//;
 435     utf8::upgrade($b);
 436     is($b, $a, "utf8::upgrade OffsetOK");
 437 }
 438
 439 {
 440     fresh_perl_like ('use utf8; utf8::moo()',
 441                      qr/Undefined subroutine utf8::moo/, {stderr=>1},
 442                     "Check Carp is loaded for AUTOLOADing errors")
 443 }
 444
 445 {
 446     # failure of is_utf8_char() without NATIVE_TO_UTF on EBCDIC (0260..027F)
 447     ok(utf8::valid(chr(0x250)), "0x250");
 448     ok(utf8::valid(chr(0x260)), "0x260");
 449     ok(utf8::valid(chr(0x270)), "0x270");
 450     ok(utf8::valid(chr(0x280)), "0x280");
 451 }
 452
 453 {
 454    use utf8;
 455    ok( !utf8::is_utf8( "asd"         ), "Wasteful format - qq{}" );
 456    ok( !utf8::is_utf8( 'asd'         ), "Wasteful format - q{}" );
 457    ok( !utf8::is_utf8( qw(asd)       ), "Wasteful format - qw{}" );
 458    ok( !utf8::is_utf8( (asd => 1)[0] ), "Wasteful format - =>" );
 459    ok( !utf8::is_utf8( -asd          ), "Wasteful format - -word" );
 460    no warnings 'bareword';
 461    ok( !utf8::is_utf8( asd::         ), "Wasteful format - word::" );
 462    no warnings 'reserved';
 463    no strict 'subs';
 464    ok( !utf8::is_utf8( asd           ), "Wasteful format - bareword" );
 465 }
 466
 467 {
 468     my @highest =
 469         (undef, 0x7F, 0x7FF, 0xFFFF, 0x1FFFFF, 0x3FFFFFF, 0x7FFFFFFF);
 470     my @step =
 471         (undef, undef, 0x40, 0x1000, 0x40000, 0x1000000, 0x40000000);
 472
 473     foreach my $length (6, 5, 4, 3, 2) {
 474         my $high = $highest[$length];
 475         while ($high > $highest[$length - 1]) {
 476             my $low = $high - $step[$length] + 1;
 477             $low = $highest[$length - 1] + 1 if $low <= $highest[$length - 1];
 478             ok(utf8::valid(do {no warnings 'utf8'; chr $low}),
 479                sprintf "chr %x, length $length is valid", $low);
 480             ok(utf8::valid(do {no warnings 'utf8'; chr $high}),
 481                sprintf "chr %x, length $length is valid", $high);
 482             $high -= $step[$length];
 483         }
 484     }
 485 }
 486
 487 # #80190 update pos, and cached length/position-mapping after
 488 # utf8 upgrade/downgrade, encode/decode
 489
 490 for my $pos (0..5) {
 491
 492     my $pos1 = ($pos >= 3)  ? 2 : ($pos >= 1) ? 1 : 0;
 493     my $pos2 = ($pos1 == 2) ? 3 : $pos1;
 494
 495     my $p;
 496     my $s = "A\xc8\x81\xe8\xab\x86\x{100}";
 497     chop($s);
 498
 499     pos($s) = $pos;
 500     # also sets cache
 501     is(length($s), 6,              "(pos $pos) len before    utf8::downgrade");
 502     is(pos($s),    $pos,           "(pos $pos) pos before    utf8::downgrade");
 503     utf8::downgrade($s);
 504     is(length($s), 6,              "(pos $pos) len after     utf8::downgrade");
 505     is(pos($s),    $pos,           "(pos $pos) pos after     utf8::downgrade");
 506     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after     utf8::downgrade");
 507     utf8::decode($s);
 508     is(length($s), 3,              "(pos $pos) len after  D; utf8::decode");
 509     is(pos($s),    $pos1,          "(pos $pos) pos after  D; utf8::decode");
 510     is($s, "A\x{201}\x{8ac6}",     "(pos $pos) str after  D; utf8::decode");
 511     utf8::encode($s);
 512     is(length($s), 6,              "(pos $pos) len after  D; utf8::encode");
 513     is(pos($s),    $pos2,          "(pos $pos) pos after  D; utf8::encode");
 514     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after  D; utf8::encode");
 515
 516     $s = "A\xc8\x81\xe8\xab\x86";
 517
 518     pos($s) = $pos;
 519     is(length($s), 6,              "(pos $pos) len before    utf8::upgrade");
 520     is(pos($s),    $pos,           "(pos $pos) pos before    utf8::upgrade");
 521     utf8::upgrade($s);
 522     is(length($s), 6,              "(pos $pos) len after     utf8::upgrade");
 523     is(pos($s),    $pos,           "(pos $pos) pos after     utf8::upgrade");
 524     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after     utf8::upgrade");
 525     utf8::decode($s);
 526     is(length($s), 3,              "(pos $pos) len after  U; utf8::decode");
 527     is(pos($s),    $pos1,          "(pos $pos) pos after  U; utf8::decode");
 528     is($s, "A\x{201}\x{8ac6}",     "(pos $pos) str after  U; utf8::decode");
 529     utf8::encode($s);
 530     is(length($s), 6,              "(pos $pos) len after  U; utf8::encode");
 531     is(pos($s),    $pos2,          "(pos $pos) pos after  U; utf8::encode");
 532     is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after  U; utf8::encode");
 533 }
 534
 535 done_testing();