This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [ID 20001018.008] flip-flop bug when there's no <FH>
[perl5.git] / t / pragma / utf8.t
CommitLineData
f96ec2a2
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
f96ec2a2 6 $ENV{PERL5LIB} = '../lib';
f70c35af
GS
7 if ( ord("\t") != 9 ) { # skip on ebcdic platforms
8 print "1..0 # Skip utf8 tests on ebcdic platform.\n";
9 exit;
10 }
f96ec2a2
GS
11}
12
93f04dac 13print "1..87\n";
f96ec2a2
GS
14
15my $test = 1;
16
17sub ok {
18 my ($got,$expect) = @_;
19 print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
20 print "ok $test\n";
21}
22
7bbb0251
JH
23sub nok {
24 my ($got,$expect) = @_;
25 print "# expected not [$expect], got [$got]\nnot " if $got eq $expect;
26 print "ok $test\n";
27}
28
be341bce
GS
29sub ok_bytes {
30 use bytes;
31 my ($got,$expect) = @_;
32 print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
33 print "ok $test\n";
34}
35
7bbb0251
JH
36sub nok_bytes {
37 use bytes;
38 my ($got,$expect) = @_;
39 print "# expected not [$expect], got [$got]\nnot " if $got eq $expect;
40 print "ok $test\n";
41}
be341bce 42
f96ec2a2
GS
43{
44 use utf8;
45 $_ = ">\x{263A}<";
46 s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg;
47 ok $_, '>&#9786;<';
c5cc3500 48 $test++; # 1
f96ec2a2
GS
49
50 $_ = ">\x{263A}<";
51 my $rx = "\x{80}-\x{10ffff}";
52 s/([$rx])/"&#".ord($1).";"/eg;
53 ok $_, '>&#9786;<';
c5cc3500 54 $test++; # 2
f96ec2a2
GS
55
56 $_ = ">\x{263A}<";
57 my $rx = "\\x{80}-\\x{10ffff}";
58 s/([$rx])/"&#".ord($1).";"/eg;
59 ok $_, '>&#9786;<';
c5cc3500 60 $test++; # 3
b8c5462f
JH
61
62 $_ = "alpha,numeric";
63 m/([[:alpha:]]+)/;
64 ok $1, 'alpha';
c5cc3500 65 $test++; # 4
b8c5462f
JH
66
67 $_ = "alphaNUMERICstring";
68 m/([[:^lower:]]+)/;
69 ok $1, 'NUMERIC';
c5cc3500 70 $test++; # 5
b8c5462f
JH
71
72 $_ = "alphaNUMERICstring";
73 m/(\p{Ll}+)/;
74 ok $1, 'alpha';
c5cc3500 75 $test++; # 6
b8c5462f
JH
76
77 $_ = "alphaNUMERICstring";
78 m/(\p{Lu}+)/;
79 ok $1, 'NUMERIC';
c5cc3500 80 $test++; # 7
b8c5462f
JH
81
82 $_ = "alpha,numeric";
83 m/([\p{IsAlpha}]+)/;
84 ok $1, 'alpha';
c5cc3500 85 $test++; # 8
b8c5462f
JH
86
87 $_ = "alphaNUMERICstring";
88 m/([^\p{IsLower}]+)/;
89 ok $1, 'NUMERIC';
c5cc3500 90 $test++; # 9
b8c5462f 91
0f4b6630
JH
92 $_ = "alpha123numeric456";
93 m/([\p{IsDigit}]+)/;
94 ok $1, '123';
c5cc3500 95 $test++; # 10
b8c5462f 96
0f4b6630
JH
97 $_ = "alpha123numeric456";
98 m/([^\p{IsDigit}]+)/;
99 ok $1, 'alpha';
c5cc3500 100 $test++; # 11
b8c5462f 101
0f4b6630
JH
102 $_ = ",123alpha,456numeric";
103 m/([\p{IsAlnum}]+)/;
104 ok $1, '123alpha';
c5cc3500 105 $test++; # 12
0f4b6630 106}
a197cbdd
GS
107{
108 use utf8;
109
110 $_ = "\x{263A}>\x{263A}\x{263A}";
111
112 ok length, 4;
c5cc3500 113 $test++; # 13
a197cbdd
GS
114
115 ok length((m/>(.)/)[0]), 1;
c5cc3500 116 $test++; # 14
a197cbdd
GS
117
118 ok length($&), 2;
c5cc3500 119 $test++; # 15
a197cbdd
GS
120
121 ok length($'), 1;
c5cc3500 122 $test++; # 16
a197cbdd
GS
123
124 ok length($`), 1;
c5cc3500 125 $test++; # 17
a197cbdd
GS
126
127 ok length($1), 1;
c5cc3500 128 $test++; # 18
a197cbdd
GS
129
130 ok length($tmp=$&), 2;
c5cc3500 131 $test++; # 19
a197cbdd
GS
132
133 ok length($tmp=$'), 1;
c5cc3500 134 $test++; # 20
a197cbdd
GS
135
136 ok length($tmp=$`), 1;
c5cc3500 137 $test++; # 21
a197cbdd
GS
138
139 ok length($tmp=$1), 1;
c5cc3500 140 $test++; # 22
a197cbdd 141
c5cc3500 142 {
be341bce 143 use bytes;
c5cc3500 144
be341bce 145 my $tmp = $&;
c5cc3500
GS
146 ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
147 $test++; # 23
a197cbdd 148
c5cc3500
GS
149 $tmp = $';
150 ok $tmp, pack("C*", 0342, 0230, 0272);
151 $test++; # 24
a197cbdd 152
c5cc3500
GS
153 $tmp = $`;
154 ok $tmp, pack("C*", 0342, 0230, 0272);
155 $test++; # 25
a197cbdd 156
c5cc3500
GS
157 $tmp = $1;
158 ok $tmp, pack("C*", 0342, 0230, 0272);
159 $test++; # 26
160 }
a197cbdd 161
be341bce
GS
162 ok_bytes $&, pack("C*", ord(">"), 0342, 0230, 0272);
163 $test++; # 27
164
165 ok_bytes $', pack("C*", 0342, 0230, 0272);
166 $test++; # 28
167
168 ok_bytes $`, pack("C*", 0342, 0230, 0272);
169 $test++; # 29
170
171 ok_bytes $1, pack("C*", 0342, 0230, 0272);
172 $test++; # 30
173
a197cbdd
GS
174 {
175 use bytes;
176 no utf8;
177
178 ok length, 10;
be341bce 179 $test++; # 31
a197cbdd
GS
180
181 ok length((m/>(.)/)[0]), 1;
be341bce 182 $test++; # 32
a197cbdd
GS
183
184 ok length($&), 2;
be341bce 185 $test++; # 33
a197cbdd
GS
186
187 ok length($'), 5;
be341bce 188 $test++; # 34
a197cbdd
GS
189
190 ok length($`), 3;
be341bce 191 $test++; # 35
a197cbdd
GS
192
193 ok length($1), 1;
be341bce 194 $test++; # 36
a197cbdd
GS
195
196 ok $&, pack("C*", ord(">"), 0342);
be341bce 197 $test++; # 37
a197cbdd
GS
198
199 ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
be341bce 200 $test++; # 38
a197cbdd
GS
201
202 ok $`, pack("C*", 0342, 0230, 0272);
be341bce 203 $test++; # 39
a197cbdd
GS
204
205 ok $1, pack("C*", 0342);
be341bce 206 $test++; # 40
a197cbdd
GS
207
208 }
209
210
211 {
212 no utf8;
213 $_="\342\230\272>\342\230\272\342\230\272";
214 }
215
216 ok length, 10;
be341bce 217 $test++; # 41
a197cbdd
GS
218
219 ok length((m/>(.)/)[0]), 1;
be341bce 220 $test++; # 42
a197cbdd
GS
221
222 ok length($&), 2;
be341bce 223 $test++; # 43
a197cbdd
GS
224
225 ok length($'), 1;
be341bce 226 $test++; # 44
a197cbdd
GS
227
228 ok length($`), 1;
be341bce 229 $test++; # 45
a197cbdd
GS
230
231 ok length($1), 1;
be341bce 232 $test++; # 46
a197cbdd
GS
233
234 ok length($tmp=$&), 2;
be341bce 235 $test++; # 47
a197cbdd
GS
236
237 ok length($tmp=$'), 1;
be341bce 238 $test++; # 48
a197cbdd
GS
239
240 ok length($tmp=$`), 1;
be341bce 241 $test++; # 49
a197cbdd
GS
242
243 ok length($tmp=$1), 1;
be341bce 244 $test++; # 50
a197cbdd 245
c5cc3500
GS
246 {
247 use bytes;
a197cbdd 248
c5cc3500
GS
249 my $tmp = $&;
250 ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
be341bce 251 $test++; # 51
a197cbdd 252
c5cc3500
GS
253 $tmp = $';
254 ok $tmp, pack("C*", 0342, 0230, 0272);
be341bce 255 $test++; # 52
a197cbdd 256
c5cc3500
GS
257 $tmp = $`;
258 ok $tmp, pack("C*", 0342, 0230, 0272);
be341bce 259 $test++; # 53
a197cbdd 260
c5cc3500
GS
261 $tmp = $1;
262 ok $tmp, pack("C*", 0342, 0230, 0272);
be341bce 263 $test++; # 54
c5cc3500 264 }
a197cbdd
GS
265 {
266 use bytes;
267 no utf8;
268
269 ok length, 10;
be341bce 270 $test++; # 55
a197cbdd
GS
271
272 ok length((m/>(.)/)[0]), 1;
be341bce 273 $test++; # 56
a197cbdd
GS
274
275 ok length($&), 2;
be341bce 276 $test++; # 57
a197cbdd
GS
277
278 ok length($'), 5;
be341bce 279 $test++; # 58
a197cbdd
GS
280
281 ok length($`), 3;
be341bce 282 $test++; # 59
a197cbdd
GS
283
284 ok length($1), 1;
be341bce 285 $test++; # 60
a197cbdd
GS
286
287 ok $&, pack("C*", ord(">"), 0342);
be341bce 288 $test++; # 61
a197cbdd
GS
289
290 ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
be341bce 291 $test++; # 62
a197cbdd
GS
292
293 ok $`, pack("C*", 0342, 0230, 0272);
be341bce 294 $test++; # 63
a197cbdd
GS
295
296 ok $1, pack("C*", 0342);
be341bce 297 $test++; # 64
a197cbdd
GS
298
299 }
de35ba6f
GS
300
301 ok "\x{ab}" =~ /^\x{ab}$/, 1;
be341bce 302 $test++; # 65
a197cbdd 303}
aaa68c4a
SC
304
305{
306 use utf8;
307 ok_bytes chr(0xe2), pack("C*", 0xc3, 0xa2);
308 $test++; # 66
309}
28cb3359
JH
310
311{
312 use utf8;
313 my @a = map ord, split(//, join("", map chr, (1234, 123, 2345)));
314 ok "@a", "1234 123 2345";
315 $test++; # 67
316}
317
318{
319 use utf8;
320 my $x = chr(123);
321 my @a = map ord, split(/$x/, join("", map chr, (1234, 123, 2345)));
322 ok "@a", "1234 2345";
323 $test++; # 68
324}
31067593 325
7bbb0251 326{
da450f52
JH
327 # bug id 20001009.001
328
329 my($a,$b);
330 { use bytes; $a = "\xc3\xa4"; }
331 { use utf8; $b = "\xe4"; }
332 { use bytes; ok_bytes $a, $b; $test++; } # 69
333 { use utf8; nok $a, $b; $test++; } # 70
7bbb0251 334}
31067593
JH
335
336{
da450f52
JH
337 # bug id 20001008.001
338
31067593
JH
339 my @x = ("stra\337e 138","stra\337e 138");
340 for (@x) {
341 s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
342 my($latin) = /^(.+)(?:\s+\d)/;
343 print $latin eq "stra\337e" ? "ok $test\n" :
344 "#latin[$latin]\nnot ok $test\n";
345 $test++;
346 $latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
347 use utf8;
348 $latin =~ s!(s)tr(?:aß|s+e)!$1tr.!; # \303\237 after the a
349 }
350}
b7018214
JH
351
352{
da450f52
JH
353 # bug id 20000819.004
354
b7018214
JH
355 $_ = $dx = "\x{10f2}";
356 s/($dx)/$dx$1/;
357 {
358 use bytes;
359 print "not " unless $_ eq "$dx$dx";
360 print "ok $test\n";
361 $test++;
362 }
363
364 $_ = $dx = "\x{10f2}";
365 s/($dx)/$1$dx/;
366 {
367 use bytes;
368 print "not " unless $_ eq "$dx$dx";
369 print "ok $test\n";
370 $test++;
371 }
372
373 $dx = "\x{10f2}";
374 $_ = "\x{10f2}\x{10f2}";
375 s/($dx)($dx)/$1$2/;
376 {
377 use bytes;
378 print "not " unless $_ eq "$dx$dx";
379 print "ok $test\n";
380 $test++;
381 }
382}
8b72f7e2
JH
383
384{
da450f52
JH
385 # bug id 20000323.056
386
8b72f7e2
JH
387 use utf8;
388
389 print "not " unless "\x{41}" eq +v65;
390 print "ok $test\n";
391 $test++;
392
393 print "not " unless "\x41" eq +v65;
394 print "ok $test\n";
395 $test++;
396
397 print "not " unless "\x{c8}" eq +v200;
398 print "ok $test\n";
399 $test++;
400
401 print "not " unless "\xc8" eq +v200;
402 print "ok $test\n";
403 $test++;
404
405 print "not " unless "\x{221b}" eq v8731;
406 print "ok $test\n";
407 $test++;
408}
da450f52
JH
409
410{
411 # bug id 20000427.003
412
413 use utf8;
414 use warnings;
415 use strict;
416
417 my $sushi = "\x{b36c}\x{5a8c}\x{ff5b}\x{5079}\x{505b}";
418
419 my @charlist = split //, $sushi;
420 my $r = '';
421 foreach my $ch (@charlist) {
422 $r = $r . " " . sprintf "U+%04X", ord($ch);
423 }
424
425 print "not " unless $r eq " U+B36C U+5A8C U+FF5B U+5079 U+505B";
426 print "ok $test\n";
427 $test++;
428}
429
430{
431 # bug id 20000901.092
432 # test that undef left and right of utf8 results in a valid string
433
434 my $a;
435 $a .= "\x{1ff}";
436 print "not " unless $a eq "\x{1ff}";
437 print "ok $test\n";
438 $test++;
439}
93f04dac
JH
440
441{
442 # bug id 20000426.003
443
444 use utf8;
445
446 my $s = "\x20\x40\x{80}\x{100}\x{80}\x40\x20";
447
448 my ($a, $b, $c) = split(/\x40/, $s);
449 print "not "
450 unless $a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a;
451 print "ok $test\n";
452 $test++;
453
454 my ($a, $b) = split(/\x{100}/, $s);
455 print "not " unless $a eq "\x20\x40\x{80}" && $b eq "\x{80}\x40\x20";
456 print "ok $test\n";
457 $test++;
458
459 my ($a, $b) = split(/\x{80}\x{100}\x{80}/, $s);
460 print "not " unless $a eq "\x20\x40" && $b eq "\x40\x20";
461 print "ok $test\n";
462 $test++;
463
464 my ($a, $b) = split(/\x40\x{80}/, $s);
465 print "not " unless $a eq "\x20" && $b eq "\x{100}\x{80}\x40\x20";
466 print "ok $test\n";
467 $test++;
468
469 my ($a, $b, $c) = split(/[\x40\x{80}]+/, $s);
470 print "not " unless $a eq "\x20" && $b eq "\x{100}" && $c eq "\x20";
471 print "ok $test\n";
472 $test++;
473}