This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #90064] perlfunc: Document special 0 mode for dbmopen
[perl5.git] / lib / utf8.t
CommitLineData
f96ec2a2
GS
1#!./perl
2
47520729
JH
3my $has_perlio;
4
f96ec2a2
GS
5BEGIN {
6 chdir 't' if -d 't';
20822f61 7 @INC = '../lib';
8ae6c9f9 8 require './test.pl';
47520729
JH
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.
12EOF
13 }
f96ec2a2
GS
14}
15
e4dc48dc
NC
16use strict;
17use warnings;
e9f01ab9
JH
18no utf8; # Ironic, no?
19
4765795a
JH
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
7bbb0251 42{
da450f52
JH
43 # bug id 20001009.001
44
89491803
SC
45 my ($a, $b);
46
47 { use bytes; $a = "\xc3\xa4" }
4765795a 48 { use utf8; $b = "\xe4" }
89491803 49
4765795a 50 my $test = 68;
31067593 51
4765795a 52 ok($a ne $b);
da450f52 53
4765795a 54 { use utf8; ok($a ne $b) }
da450f52
JH
55}
56
60ff4832
JH
57
58{
59 # bug id 20000730.004
60
60ff4832
JH
61 my $smiley = "\x{263a}";
62
4765795a
JH
63 for my $s ("\x{263a}",
64 $smiley,
60ff4832 65
4765795a
JH
66 "" . $smiley,
67 "" . "\x{263a}",
60ff4832 68
4765795a
JH
69 $smiley . "",
70 "\x{263a}" . "",
60ff4832
JH
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;
4765795a
JH
79 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
80 "1/1/1/3");
60ff4832
JH
81 }
82
4765795a
JH
83 for my $s ("\x{263a}" . "\x{263a}",
84 $smiley . $smiley,
60ff4832 85
4765795a
JH
86 "\x{263a}\x{263a}",
87 "$smiley$smiley",
60ff4832 88
4765795a
JH
89 "\x{263a}" x 2,
90 $smiley x 2,
60ff4832
JH
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;
4765795a
JH
99 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
100 "2/2/2/6");
60ff4832
JH
101 }
102}
ffc61ed2 103
ffc61ed2
JH
104
105{
f9a63242
JH
106 my $w = 0;
107 local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
108 my $x = eval q/"\\/ . "\x{100}" . q/"/;;
109
4765795a 110 ok($w == 0 && $x eq "\x{100}");
f9a63242
JH
111}
112
8ae6c9f9 113{
4c26891c
NC
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.
8ae6c9f9 124 my $progfile = 'utf' . $$;
435e7af6
NC
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;
4c26891c
NC
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];
435e7af6 142 }
4c26891c
NC
143 # Now we've done all the UTF8 munching hopefully we're safe
144 my @tests = (
435e7af6 145 ['check our detection program works',
4c26891c 146 'my @a = ("'.chr(60).'\x2A", ""); $b = show @a', qr/^>60,42<><$/],
435e7af6 147 ['check literal 8 bit input',
4c26891c 148 '$a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
435e7af6 149 ['check no utf8; makes no change',
4c26891c 150 'no utf8; $a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
435e7af6
NC
151 # Now we do the real byte sequences that are valid UTF8
152 (map {
153 ["the utf8 sequence for chr $_->[0]",
347a2837 154 qq{\$a = "$_->[1]"; \$b = show \$a}, qr/^>$_->[2]<$/],
435e7af6 155 ["no utf8; for the utf8 sequence for chr $_->[0]",
4c26891c 156 qq(no utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[2]<$/],
435e7af6 157 ["use utf8; for the utf8 sequence for chr $_->[0]",
4c26891c 158 qq(use utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[0]<$/],
435e7af6
NC
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",
8ae6c9f9 165 use utf8; %a = ("\xE1\xA0"=>"sterling");
435e7af6 166 print 'start'; printf '%x,', ord \$_ foreach keys %a; print "end\n";
8ae6c9f9 167BANG
746b446a 168 qr/^Malformed UTF-8 character \(\d bytes?, need \d, .+\).*start\d+,end$/sm
435e7af6 169 ],
4c26891c
NC
170 );
171 foreach (@tests) {
435e7af6
NC
172 my ($why, $prog, $expect) = @$_;
173 open P, ">$progfile" or die "Can't open '$progfile': $!";
47520729 174 binmode(P, ":bytes") if $has_perlio;
4c26891c
NC
175 print P $show, $prog, '; print $b'
176 or die "Print to 'progfile' failed: $!";
435e7af6
NC
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 }
4c26891c
NC
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
a6d05634 189 # evals do the same thing. Hopefully doing it later successfully decouples
4c26891c
NC
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 }
8ae6c9f9 264}
107c2363
MP
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#
a901eef8
JH
272SKIP: {
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; };
107c2363
MP
276 {
277 use utf8;
278 eval $code;
279 print $@ if $@;
280 }
281CODE
a901eef8 282}
a5b510f2
AE
283
284{
285 use utf8;
286 $a = <<'END';
2870 ....... 1 ....... 2 ....... 3 ....... 4 ....... 5 ....... 6 ....... 7 .......
288END
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
a901eef8
JH
326SKIP: {
327 skip("Embedded UTF-8 does not work in EBCDIC", 1) if ord("A") == 193;
220e2d4e 328 use utf8;
ab10b0e5 329 is eval qq{q \xc3\xbc test \xc3\xbc . qq\xc2\xb7 test \xc2\xb7},
7b301413
FC
330 ' test test ',
331 "utf8 quote delimiters [perl #16823]";
220e2d4e 332}
6e37fd2a
JH
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");
2f3efc97
JH
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 }
6e37fd2a
JH
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");
2f3efc97
JH
386 if (ord('A') == 193) { # EBCDIC.
387 is(length($b), 1, "beyond length");
388 } else {
389 is(length($b), 2, "beyond length");
390 }
6e37fd2a
JH
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");
2f3efc97
JH
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 }
6e37fd2a
JH
420 ok( utf8::is_utf8($c), " utf8::is_utf8 unicode");
421}
5fec3b1d
NC
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}
06a45632
ST
428
429{
b2b7346b
FC
430 # Make sure utf8::decode respects copy-on-write [perl #91834].
431 # Hash keys are the easiest way to test this.
432 my $name = "\x{c3}\x{b3}";
433 my ($k1) = keys %{ { $name=>undef } };
434 my $k2 = $name;
435 utf8::decode($k1);
436 utf8::decode($k2);
437 my $h = { $k1 => 1, $k2 => 2 };
438 is join('', keys $h), $k2, 'utf8::decode respects copy-on-write';
439}
440
441{
ccc73c2d 442 my $a = "456\xb6";
06a45632
ST
443 utf8::upgrade($a);
444
ccc73c2d
RGS
445 my $b = "123456\xb6";
446 $b =~ s/^...//;
06a45632
ST
447 utf8::upgrade($b);
448 is($b, $a, "utf8::upgrade OffsetOK");
449}
bd7017d3
NC
450
451{
452 fresh_perl_like ('use utf8; utf8::moo()',
453 qr/Undefined subroutine utf8::moo/, {stderr=>1},
454 "Check Carp is loaded for AUTOLOADing errors")
455}
77263263
ST
456
457{
458 # failure of is_utf8_char() without NATIVE_TO_UTF on EBCDIC (0260..027F)
459 ok(utf8::valid(chr(0x250)), "0x250");
460 ok(utf8::valid(chr(0x260)), "0x260");
461 ok(utf8::valid(chr(0x270)), "0x270");
462 ok(utf8::valid(chr(0x280)), "0x280");
463}
96d9949f
EB
464
465{
466 use utf8;
467 ok( !utf8::is_utf8( "asd" ), "Wasteful format - qq{}" );
468 ok( !utf8::is_utf8( 'asd' ), "Wasteful format - q{}" );
469 ok( !utf8::is_utf8( qw(asd) ), "Wasteful format - qw{}" );
470 ok( !utf8::is_utf8( (asd => 1)[0] ), "Wasteful format - =>" );
96d9949f 471 ok( !utf8::is_utf8( -asd ), "Wasteful format - -word" );
e4dc48dc 472 no warnings 'bareword';
96d9949f 473 ok( !utf8::is_utf8( asd:: ), "Wasteful format - word::" );
e4dc48dc
NC
474 no warnings 'reserved';
475 no strict 'subs';
476 ok( !utf8::is_utf8( asd ), "Wasteful format - bareword" );
96d9949f 477}
a18d6e6e
NC
478
479{
480 my @highest =
481 (undef, 0x7F, 0x7FF, 0xFFFF, 0x1FFFFF, 0x3FFFFFF, 0x7FFFFFFF);
482 my @step =
483 (undef, undef, 0x40, 0x1000, 0x40000, 0x1000000, 0x40000000);
484
485 foreach my $length (6, 5, 4, 3, 2) {
486 my $high = $highest[$length];
487 while ($high > $highest[$length - 1]) {
488 my $low = $high - $step[$length] + 1;
489 $low = $highest[$length - 1] + 1 if $low <= $highest[$length - 1];
490 ok(utf8::valid(do {no warnings 'utf8'; chr $low}),
491 sprintf "chr %x, length $length is valid", $low);
492 ok(utf8::valid(do {no warnings 'utf8'; chr $high}),
493 sprintf "chr %x, length $length is valid", $high);
494 $high -= $step[$length];
495 }
496 }
497}
498
75da9d4c
DM
499# #80190 update pos, and cached length/position-mapping after
500# utf8 upgrade/downgrade, encode/decode
501
502for my $pos (0..5) {
503
504 my $pos1 = ($pos >= 3) ? 2 : ($pos >= 1) ? 1 : 0;
505 my $pos2 = ($pos1 == 2) ? 3 : $pos1;
506
507 my $p;
508 my $s = "A\xc8\x81\xe8\xab\x86\x{100}";
509 chop($s);
510
511 pos($s) = $pos;
512 # also sets cache
513 is(length($s), 6, "(pos $pos) len before utf8::downgrade");
514 is(pos($s), $pos, "(pos $pos) pos before utf8::downgrade");
515 utf8::downgrade($s);
516 is(length($s), 6, "(pos $pos) len after utf8::downgrade");
517 is(pos($s), $pos, "(pos $pos) pos after utf8::downgrade");
518 is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after utf8::downgrade");
519 utf8::decode($s);
520 is(length($s), 3, "(pos $pos) len after D; utf8::decode");
521 is(pos($s), $pos1, "(pos $pos) pos after D; utf8::decode");
522 is($s, "A\x{201}\x{8ac6}", "(pos $pos) str after D; utf8::decode");
523 utf8::encode($s);
524 is(length($s), 6, "(pos $pos) len after D; utf8::encode");
525 is(pos($s), $pos2, "(pos $pos) pos after D; utf8::encode");
526 is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after D; utf8::encode");
527
528 $s = "A\xc8\x81\xe8\xab\x86";
529
530 pos($s) = $pos;
531 is(length($s), 6, "(pos $pos) len before utf8::upgrade");
532 is(pos($s), $pos, "(pos $pos) pos before utf8::upgrade");
533 utf8::upgrade($s);
534 is(length($s), 6, "(pos $pos) len after utf8::upgrade");
535 is(pos($s), $pos, "(pos $pos) pos after utf8::upgrade");
536 is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after utf8::upgrade");
537 utf8::decode($s);
538 is(length($s), 3, "(pos $pos) len after U; utf8::decode");
539 is(pos($s), $pos1, "(pos $pos) pos after U; utf8::decode");
540 is($s, "A\x{201}\x{8ac6}", "(pos $pos) str after U; utf8::decode");
541 utf8::encode($s);
542 is(length($s), 6, "(pos $pos) len after U; utf8::encode");
543 is(pos($s), $pos2, "(pos $pos) pos after U; utf8::encode");
544 is($s, "A\xc8\x81\xe8\xab\x86","(pos $pos) str after U; utf8::encode");
545}
546
a18d6e6e 547done_testing();