Start migrating bits of pragma/utf8 to elsewhere
[perl.git] / t / pragma / utf8.t
1 #!./perl 
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     $ENV{PERL5LIB} = '../lib';
7     if ( ord("\t") != 9 ) { # skip on ebcdic platforms
8         print "1..0 # Skip utf8 tests on ebcdic platform.\n";
9         exit;
10     }
11 }
12
13 print "1..181\n";
14
15 my $test = 1;
16
17 sub ok {
18     my ($got,$expect) = @_;
19     print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
20     print "ok $test\n";
21 }
22
23 sub nok {
24     my ($got,$expect) = @_;
25     print "# expected not [$expect], got [$got]\nnot " if $got eq $expect;
26     print "ok $test\n";
27 }
28
29 sub 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
36 sub 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 }
42
43 {
44     use utf8;
45     $_ = ">\x{263A}<"; 
46     s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg; 
47     ok $_, '>&#9786;<';
48     $test++;                            # 1
49
50     $_ = ">\x{263A}<"; 
51     my $rx = "\x{80}-\x{10ffff}";
52     s/([$rx])/"&#".ord($1).";"/eg; 
53     ok $_, '>&#9786;<';
54     $test++;                            # 2
55
56     $_ = ">\x{263A}<"; 
57     my $rx = "\\x{80}-\\x{10ffff}";
58     s/([$rx])/"&#".ord($1).";"/eg; 
59     ok $_, '>&#9786;<';
60     $test++;                            # 3
61
62     $_ = "alpha,numeric"; 
63     m/([[:alpha:]]+)/; 
64     ok $1, 'alpha';
65     $test++;                            # 4
66
67     $_ = "alphaNUMERICstring";
68     m/([[:^lower:]]+)/; 
69     ok $1, 'NUMERIC';
70     $test++;                            # 5
71
72     $_ = "alphaNUMERICstring";
73     m/(\p{Ll}+)/; 
74     ok $1, 'alpha';
75     $test++;                            # 6
76
77     $_ = "alphaNUMERICstring"; 
78     m/(\p{Lu}+)/; 
79     ok $1, 'NUMERIC';
80     $test++;                            # 7
81
82     $_ = "alpha,numeric"; 
83     m/([\p{IsAlpha}]+)/; 
84     ok $1, 'alpha';
85     $test++;                            # 8
86
87     $_ = "alphaNUMERICstring";
88     m/([^\p{IsLower}]+)/; 
89     ok $1, 'NUMERIC';
90     $test++;                            # 9
91
92     $_ = "alpha123numeric456"; 
93     m/([\p{IsDigit}]+)/; 
94     ok $1, '123';
95     $test++;                            # 10
96
97     $_ = "alpha123numeric456"; 
98     m/([^\p{IsDigit}]+)/; 
99     ok $1, 'alpha';
100     $test++;                            # 11
101
102     $_ = ",123alpha,456numeric"; 
103     m/([\p{IsAlnum}]+)/; 
104     ok $1, '123alpha';
105     $test++;                            # 12
106 }
107 {
108     use utf8;
109
110     $_ = "\x{263A}>\x{263A}\x{263A}"; 
111
112     ok length, 4;
113     $test++;                            # 13
114
115     ok length((m/>(.)/)[0]), 1;
116     $test++;                            # 14
117
118     ok length($&), 2;
119     $test++;                            # 15
120
121     ok length($'), 1;
122     $test++;                            # 16
123
124     ok length($`), 1;
125     $test++;                            # 17
126
127     ok length($1), 1;
128     $test++;                            # 18
129
130     ok length($tmp=$&), 2;
131     $test++;                            # 19
132
133     ok length($tmp=$'), 1;
134     $test++;                            # 20
135
136     ok length($tmp=$`), 1;
137     $test++;                            # 21
138
139     ok length($tmp=$1), 1;
140     $test++;                            # 22
141
142     {
143         use bytes;
144
145         my $tmp = $&;
146         ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
147         $test++;                                # 23
148
149         $tmp = $';
150         ok $tmp, pack("C*", 0342, 0230, 0272);
151         $test++;                                # 24
152
153         $tmp = $`;
154         ok $tmp, pack("C*", 0342, 0230, 0272);
155         $test++;                                # 25
156
157         $tmp = $1;
158         ok $tmp, pack("C*", 0342, 0230, 0272);
159         $test++;                                # 26
160     }
161
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
174     {
175         use bytes;
176         no utf8;
177
178         ok length, 10;
179         $test++;                                # 31
180
181         ok length((m/>(.)/)[0]), 1;
182         $test++;                                # 32
183
184         ok length($&), 2;
185         $test++;                                # 33
186
187         ok length($'), 5;
188         $test++;                                # 34
189
190         ok length($`), 3;
191         $test++;                                # 35
192
193         ok length($1), 1;
194         $test++;                                # 36
195
196         ok $&, pack("C*", ord(">"), 0342);
197         $test++;                                # 37
198
199         ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
200         $test++;                                # 38
201
202         ok $`, pack("C*", 0342, 0230, 0272);
203         $test++;                                # 39
204
205         ok $1, pack("C*", 0342);
206         $test++;                                # 40
207
208     }
209
210
211     {
212         no utf8;
213         $_="\342\230\272>\342\230\272\342\230\272";
214     }
215
216     ok length, 10;
217     $test++;                            # 41
218
219     ok length((m/>(.)/)[0]), 1;
220     $test++;                            # 42
221
222     ok length($&), 2;
223     $test++;                            # 43
224
225     ok length($'), 1;
226     $test++;                            # 44
227
228     ok length($`), 1;
229     $test++;                            # 45
230
231     ok length($1), 1;
232     $test++;                            # 46
233
234     ok length($tmp=$&), 2;
235     $test++;                            # 47
236
237     ok length($tmp=$'), 1;
238     $test++;                            # 48
239
240     ok length($tmp=$`), 1;
241     $test++;                            # 49
242
243     ok length($tmp=$1), 1;
244     $test++;                            # 50
245
246     {
247         use bytes;
248
249         my $tmp = $&;
250         ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
251         $test++;                                # 51
252
253         $tmp = $';
254         ok $tmp, pack("C*", 0342, 0230, 0272);
255         $test++;                                # 52
256
257         $tmp = $`;
258         ok $tmp, pack("C*", 0342, 0230, 0272);
259         $test++;                                # 53
260
261         $tmp = $1;
262         ok $tmp, pack("C*", 0342, 0230, 0272);
263         $test++;                                # 54
264     }
265     {
266         use bytes;
267         no utf8;
268
269         ok length, 10;
270         $test++;                                # 55
271
272         ok length((m/>(.)/)[0]), 1;
273         $test++;                                # 56
274
275         ok length($&), 2;
276         $test++;                                # 57
277
278         ok length($'), 5;
279         $test++;                                # 58
280
281         ok length($`), 3;
282         $test++;                                # 59
283
284         ok length($1), 1;
285         $test++;                                # 60
286
287         ok $&, pack("C*", ord(">"), 0342);
288         $test++;                                # 61
289
290         ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
291         $test++;                                # 62
292
293         ok $`, pack("C*", 0342, 0230, 0272);
294         $test++;                                # 63
295
296         ok $1, pack("C*", 0342);
297         $test++;                                # 64
298
299     }
300
301     ok "\x{ab}" =~ /^\x{ab}$/, 1;
302     $test++;                                    # 65
303 }
304
305 {
306     use utf8;
307     ok_bytes chr(0xe2), pack("C*", 0xc3, 0xa2);
308     $test++;                # 66
309 }
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 }
325
326 {
327     # bug id 20001009.001
328
329     my ($a, $b);
330
331     { use bytes; $a = "\xc3\xa4" }
332     { use utf8;  $b = "\xe4"     } # \xXX must not produce UTF-8
333
334     print "not " if $a eq $b;
335     print "ok $test\n"; $test++;
336
337     { use utf8; print "not " if $a eq $b; }
338     print "ok $test\n"; $test++;
339 }
340
341 {
342     # bug id 20001008.001
343
344     my @x = ("stra\337e 138","stra\337e 138");
345     for (@x) {
346         s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
347         my($latin) = /^(.+)(?:\s+\d)/;
348         print $latin eq "stra\337e" ? "ok $test\n" :
349             "#latin[$latin]\nnot ok $test\n";
350         $test++;
351         $latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
352         use utf8;
353         $latin =~ s!(s)tr(?:aß|s+e)!$1tr.!; # \303\237 after the a
354     }
355 }
356
357 {
358     # bug id 20000819.004 
359
360     $_ = $dx = "\x{10f2}";
361     s/($dx)/$dx$1/;
362     {
363         use bytes;
364         print "not " unless $_ eq "$dx$dx";
365         print "ok $test\n";
366         $test++;
367     }
368
369     $_ = $dx = "\x{10f2}";
370     s/($dx)/$1$dx/;
371     {
372         use bytes;
373         print "not " unless $_ eq "$dx$dx";
374         print "ok $test\n";
375         $test++;
376     }
377
378     $dx = "\x{10f2}";
379     $_  = "\x{10f2}\x{10f2}";
380     s/($dx)($dx)/$1$2/;
381     {
382         use bytes;
383         print "not " unless $_ eq "$dx$dx";
384         print "ok $test\n";
385         $test++;
386     }
387 }
388
389 {
390     # bug id 20000323.056
391
392     use utf8;
393
394     print "not " unless "\x{41}" eq +v65;
395     print "ok $test\n";
396     $test++;
397
398     print "not " unless "\x41" eq +v65;
399     print "ok $test\n";
400     $test++;
401
402     print "not " unless "\x{c8}" eq +v200;
403     print "ok $test\n";
404     $test++;
405
406     print "not " unless "\xc8" eq +v200;
407     print "ok $test\n";
408     $test++;
409
410     print "not " unless "\x{221b}" eq v8731;
411     print "ok $test\n";
412     $test++;
413 }
414
415 {
416     # bug id 20000427.003 
417
418     use utf8;
419     use warnings;
420     use strict;
421
422     my $sushi = "\x{b36c}\x{5a8c}\x{ff5b}\x{5079}\x{505b}";
423
424     my @charlist = split //, $sushi;
425     my $r = '';
426     foreach my $ch (@charlist) {
427         $r = $r . " " . sprintf "U+%04X", ord($ch);
428     }
429
430     print "not " unless $r eq " U+B36C U+5A8C U+FF5B U+5079 U+505B";
431     print "ok $test\n";
432     $test++;
433 }
434
435 {
436     # bug id 20000901.092
437     # test that undef left and right of utf8 results in a valid string
438
439     my $a;
440     $a .= "\x{1ff}";
441     print "not " unless $a eq "\x{1ff}";
442     print "ok $test\n";
443     $test++;
444 }
445
446 {
447     # bug id 20000426.003
448
449     use utf8;
450
451     my $s = "\x20\x40\x{80}\x{100}\x{80}\x40\x20";
452
453     my ($a, $b, $c) = split(/\x40/, $s);
454     print "not "
455         unless $a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a;
456     print "ok $test\n";
457     $test++;
458
459     my ($a, $b) = split(/\x{100}/, $s);
460     print "not " unless $a eq "\x20\x40\x{80}" && $b eq "\x{80}\x40\x20";
461     print "ok $test\n";
462     $test++;
463
464     my ($a, $b) = split(/\x{80}\x{100}\x{80}/, $s);
465     print "not " unless $a eq "\x20\x40" && $b eq "\x40\x20";
466     print "ok $test\n";
467     $test++;
468
469     my ($a, $b) = split(/\x40\x{80}/, $s);
470     print "not " unless $a eq "\x20" && $b eq "\x{100}\x{80}\x40\x20";
471     print "ok $test\n";
472     $test++;
473
474     my ($a, $b, $c) = split(/[\x40\x{80}]+/, $s);
475     print "not " unless $a eq "\x20" && $b eq "\x{100}" && $c eq "\x20";
476     print "ok $test\n";
477     $test++;
478 }
479
480 {
481     # bug id 20000730.004
482
483     use utf8;
484
485     my $smiley = "\x{263a}";
486
487     for my $s ("\x{263a}",                     #  1
488                $smiley,                        #  2
489                 
490                "" . $smiley,                   #  3
491                "" . "\x{263a}",                #  4
492
493                $smiley    . "",                #  5
494                "\x{263a}" . "",                #  6
495                ) {
496         my $length_chars = length($s);
497         my $length_bytes;
498         { use bytes; $length_bytes = length($s) }
499         my @regex_chars = $s =~ m/(.)/g;
500         my $regex_chars = @regex_chars;
501         my @split_chars = split //, $s;
502         my $split_chars = @split_chars;
503         print "not "
504             unless "$length_chars/$regex_chars/$split_chars/$length_bytes" eq
505                    "1/1/1/3";
506         print "ok $test\n";
507         $test++;
508     }
509
510     for my $s ("\x{263a}" . "\x{263a}",        #  7
511                $smiley    . $smiley,           #  8
512
513                "\x{263a}\x{263a}",             #  9
514                "$smiley$smiley",               # 10
515                
516                "\x{263a}" x 2,                 # 11
517                $smiley    x 2,                 # 12
518                ) {
519         my $length_chars = length($s);
520         my $length_bytes;
521         { use bytes; $length_bytes = length($s) }
522         my @regex_chars = $s =~ m/(.)/g;
523         my $regex_chars = @regex_chars;
524         my @split_chars = split //, $s;
525         my $split_chars = @split_chars;
526         print "not "
527             unless "$length_chars/$regex_chars/$split_chars/$length_bytes" eq
528                    "2/2/2/6";
529         print "ok $test\n";
530         $test++;
531     }
532 }
533
534 {
535     # ID 20001020.006
536
537     "x" =~ /(.)/; # unset $2
538
539     # Without the fix this will croak:
540     # Modification of a read-only value attempted at ...
541     "$2\x{1234}";
542
543     print "ok $test\n";
544     $test++;
545
546     # For symmetry with the above.
547     "\x{1234}$2";
548
549     print "ok $test\n";
550     $test++;
551
552     *pi = \undef;
553     # This bug existed earlier than the $2 bug, but is fixed with the same
554     # patch. Without the fix this will also croak:
555     # Modification of a read-only value attempted at ...
556     "$pi\x{1234}";
557
558     print "ok $test\n";
559     $test++;
560
561     # For symmetry with the above.
562     "\x{1234}$pi";
563
564     print "ok $test\n";
565     $test++;
566 }
567
568 # This table is based on Markus Kuhn's UTF-8 Decode Stress Tester,
569 # http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt,
570 # version dated 2000-09-02. 
571
572 # Note the \0 instead of a raw zero byte in 2.1.1: for example
573 # GNU patch v2.1 has "issues" with raw zero bytes.
574
575 my @MK = split(/\n/, <<__EOMK__);
576 1       Correct UTF-8
577 1.1.1 y "κόσμε"   -               11      ce:ba:e1:bd:b9:cf:83:ce:bc:ce:b5        5
578 2       Boundary conditions 
579 2.1     First possible sequence of certain length
580 2.1.1 y "\0"                    0               1       00      1
581 2.1.2 y "\80"                    80              2       c2:80   1
582 2.1.3 y "ࠀ"           800             3       e0:a0:80        1
583 2.1.4 y "𐀀"          10000           4       f0:90:80:80     1
584 2.1.5 y "" 200000          5       f8:88:80:80:80  1
585 2.1.6 y ""        4000000         6       fc:84:80:80:80:80       1
586 2.2     Last possible sequence of certain length
587 2.2.1 y "\7f"                     7f              1       7f      1
588 2.2.2 y "߿"                    7ff             2       df:bf   1
589 # The ffff is illegal unless UTF8_ALLOW_FFFF
590 2.2.3 n "￿"                   ffff            3       ef:bf:bf        1
591 2.2.4 y ""                  1fffff          4       f7:bf:bf:bf     1
592 2.2.5 y ""                 3ffffff         5       fb:bf:bf:bf:bf  1
593 2.2.6 y ""                7fffffff        6       fd:bf:bf:bf:bf:bf       1
594 2.3     Other boundary conditions
595 2.3.1 y "퟿"           d7ff            3       ed:9f:bf        1
596 2.3.2 y ""           e000            3       ee:80:80        1
597 2.3.3 y "�"                   fffd            3       ef:bf:bd        1
598 2.3.4 y "􏿿"          10ffff          4       f4:8f:bf:bf     1
599 2.3.5 y ""          110000          4       f4:90:80:80     1
600 3       Malformed sequences
601 3.1     Unexpected continuation bytes
602 3.1.1 n "�"                     -               1       80
603 3.1.2 n "�"                     -               1       bf
604 3.1.3 n "��"                    -               2       80:bf
605 3.1.4 n "���"           -               3       80:bf:80
606 3.1.5 n "����"          -               4       80:bf:80:bf
607 3.1.6 n "�����" -               5       80:bf:80:bf:80
608 3.1.7 n "������"        -               6       80:bf:80:bf:80:bf
609 3.1.8 n "�������"       -               7       80:bf:80:bf:80:bf:80
610 3.1.9 n "����������������������������������������������������������������"                              -       64      80:81:82:83:84:85:86:87:88:89:8a:8b:8c:8d:8e:8f:90:91:92:93:94:95:96:97:98:99:9a:9b:9c:9d:9e:9f:a0:a1:a2:a3:a4:a5:a6:a7:a8:a9:aa:ab:ac:ad:ae:af:b0:b1:b2:b3:b4:b5:b6:b7:b8:b9:ba:bb:bc:bd:be:bf
611 3.2     Lonely start characters
612 3.2.1 n "� � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � "      -       64      c0:20:c1:20:c2:20:c3:20:c4:20:c5:20:c6:20:c7:20:c8:20:c9:20:ca:20:cb:20:cc:20:cd:20:ce:20:cf:20:d0:20:d1:20:d2:20:d3:20:d4:20:d5:20:d6:20:d7:20:d8:20:d9:20:da:20:db:20:dc:20:dd:20:de:20:df:20
613 3.2.2 n "� � � � � � � � � � � � � � � � "      -       32      e0:20:e1:20:e2:20:e3:20:e4:20:e5:20:e6:20:e7:20:e8:20:e9:20:ea:20:eb:20:ec:20:ed:20:ee:20:ef:20
614 3.2.3 n "� � � � � � � � "      -       16      f0:20:f1:20:f2:20:f3:20:f4:20:f5:20:f6:20:f7:20
615 3.2.4 n "� � � � "              -       8       f8:20:f9:20:fa:20:fb:20
616 3.2.5 n "� � "                  -       4       fc:20:fd:20
617 3.3     Sequences with last continuation byte missing
618 3.3.1 n "�"                     -       1       c0
619 3.3.2 n "��"                    -       2       e0:80
620 3.3.3 n "���"           -       3       f0:80:80
621 3.3.4 n "����"          -       4       f8:80:80:80
622 3.3.5 n "�����" -       5       fc:80:80:80:80
623 3.3.6 n "�"                     -       1       df
624 3.3.7 n "��"                    -       2       ef:bf
625 3.3.8 n "���"                   -       3       f7:bf:bf
626 3.3.9 n "����"                  -       4       fb:bf:bf:bf
627 3.3.10 n "�����"                -       5       fd:bf:bf:bf:bf
628 3.4     Concatenation of incomplete sequences
629 3.4.1 n "������������������������������"        -       30      c0:e0:80:f0:80:80:f8:80:80:80:fc:80:80:80:80:df:ef:bf:f7:bf:bf:fb:bf:bf:bf:fd:bf:bf:bf:bf
630 3.5     Impossible bytes
631 3.5.1 n "�"                     -       1       fe
632 3.5.2 n "�"                     -       1       ff
633 3.5.3 n "����"                  -       4       fe:fe:ff:ff
634 4       Overlong sequences
635 4.1     Examples of an overlong ASCII character
636 4.1.1 n "��"                    -       2       c0:af
637 4.1.2 n "���"           -       3       e0:80:af
638 4.1.3 n "����"          -       4       f0:80:80:af
639 4.1.4 n "�����" -       5       f8:80:80:80:af
640 4.1.5 n "������"        -       6       fc:80:80:80:80:af
641 4.2     Maximum overlong sequences
642 4.2.1 n "��"                    -       2       c1:bf
643 4.2.2 n "���"           -       3       e0:9f:bf
644 4.2.3 n "����"          -       4       f0:8f:bf:bf
645 4.2.4 n "�����"         -       5       f8:87:bf:bf:bf
646 4.2.5 n "������"                -       6       fc:83:bf:bf:bf:bf
647 4.3     Overlong representation of the NUL character
648 4.3.1 n "��"                    -       2       c0:80
649 4.3.2 n "���"           -       3       e0:80:80
650 4.3.3 n "����"          -       4       f0:80:80:80
651 4.3.4 n "�����" -       5       f8:80:80:80:80
652 4.3.5 n "������"        -       6       fc:80:80:80:80:80
653 5       Illegal code positions
654 5.1     Single UTF-16 surrogates
655 5.1.1 n ""           -       3       ed:a0:80
656 5.1.2 n ""                   -       3       ed:ad:bf
657 5.1.3 n ""           -       3       ed:ae:80
658 5.1.4 n ""                   -       3       ed:af:bf
659 5.1.5 n ""           -       3       ed:b0:80
660 5.1.6 n ""           -       3       ed:be:80
661 5.1.7 n ""                   -       3       ed:bf:bf
662 5.2     Paired UTF-16 surrogates
663 5.2.1 n ""                -       6       ed:a0:80:ed:b0:80
664 5.2.2 n ""                -       6       ed:a0:80:ed:bf:bf
665 5.2.3 n ""                -       6       ed:ad:bf:ed:b0:80
666 5.2.4 n ""                -       6       ed:ad:bf:ed:bf:bf
667 5.2.5 n ""                -       6       ed:ae:80:ed:b0:80
668 5.2.6 n ""                -       6       ed:ae:80:ed:bf:bf
669 5.2.7 n ""                -       6       ed:af:bf:ed:b0:80
670 5.2.8 n ""                -       6       ed:af:bf:ed:bf:bf
671 5.3     Other illegal code positions
672 5.3.1 n "￾"                   -       3       ef:bf:be
673 # The ffff is illegal unless UTF8_ALLOW_FFFF
674 5.3.2 n "￿"                   -       3       ef:bf:bf
675 __EOMK__
676
677 # 104..181
678 {
679     my $WARN;
680     my $id;
681
682     local $SIG{__WARN__} =
683         sub {
684             # print "# $id: @_";
685             $WARN++;
686         };
687
688     sub moan {
689         print "$id: @_";
690     }
691     
692     sub test_unpack_U {
693         $WARN = 0;
694         unpack('U*', $_[0]);
695     }
696
697     for (@MK) {
698         if (/^(?:\d+(?:\.\d+)?)\s/ || /^#/) {
699             # print "# $_\n";
700         } elsif (/^(\d+\.\d+\.\d+[bu]?)\s+([yn])\s+"(.+)"\s+([0-9a-f]{1,8}|-)\s+(\d+)\s+([0-9a-f]{2}(?::[0-9a-f]{2})*)(?:\s+(\d+))?$/) {
701             $id = $1;
702             my ($okay, $bytes, $Unicode, $byteslen, $hex, $charslen) =
703                 ($2, $3, $4, $5, $6, $7);
704             my @hex = split(/:/, $hex);
705             unless (@hex == $byteslen) {
706                 my $nhex = @hex;
707                 moan "amount of hex ($nhex) not equal to byteslen ($byteslen)\n";
708             }
709             {
710                 use bytes;
711                 my $bytesbyteslen = length($bytes);
712                 unless ($bytesbyteslen == $byteslen) {
713                     moan "bytes length() ($bytesbyteslen) not equal to $byteslen\n";
714                 }
715             }
716             if ($okay eq 'y') {
717                 test_unpack_U($bytes);
718                 unless ($WARN == 0) {
719                     moan "unpack('U*') false negative\n";
720                     print "not ";
721                 }
722             } elsif ($okay eq 'n') {
723                 test_unpack_U($bytes);
724                 unless ($WARN) {
725                     moan "unpack('U*') false positive\n";
726                     print "not ";
727                 }
728             }
729             print "ok $test\n";
730             $test++;
731         } else {
732             moan "unknown format\n";
733         }
734     }
735 }
736