6 unless(grep /blib/, @INC) {
11 $SIG{__WARN__} = sub { push @WARN, @_ };
18 use charnames ':full';
20 print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here!?";
24 use bytes; # TEST -utf8 can switch utf8 on
26 print "# \$res=$res \$\@='$@'\nnot "
27 if $res = eval <<'EOE'
28 use charnames ":full";
29 "Here: \N{CYRILLIC SMALL LETTER BE}!";
32 or $@ !~ /above 0xFF/;
34 # print "# \$res=$res \$\@='$@'\n";
36 print "# \$res=$res \$\@='$@'\nnot "
37 if $res = eval <<'EOE'
38 use charnames 'cyrillic';
42 or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
46 # If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
47 if (ord('A') == 65) { # as on ASCII or UTF-8 machines
48 $encoded_be = "\320\261";
49 $encoded_alpha = "\316\261";
50 $encoded_bet = "\327\221";
51 $encoded_deseng = "\360\220\221\215";
53 else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
54 # UTF-EBCDIC is codepage specific)
55 $encoded_be = "\270\102\130";
56 $encoded_alpha = "\264\130";
57 $encoded_bet = "\270\125\130";
58 $encoded_deseng = "\336\102\103\124";
66 use charnames ':full';
68 print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be;
71 use charnames qw(cyrillic greek :short);
73 print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}")
74 eq "$encoded_be,$encoded_alpha,$encoded_bet";
79 use charnames ':full';
80 print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}";
82 print "not " unless length("\x{263a}") == 1;
84 print "not " unless length("\N{WHITE SMILING FACE}") == 1;
86 print "not " unless sprintf("%vx", "\x{263a}") eq "263a";
88 print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a";
90 print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a";
92 print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a";
97 use charnames qw(:full);
101 my $named = "\N{CUBE ROOT}";
103 print "not " unless ord($x) == ord($named);
108 use charnames qw(:full);
110 print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}";
115 use charnames ':full';
118 unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng;
125 no utf8; # naked Latin-1
127 if (ord("Ä") == 0xc4) { # Try to do this only on Latin-1.
128 use charnames ':full';
129 my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
130 print "not " unless $text eq "\xc4" && ord($text) == 0xc4;
133 print "ok 16 # Skip: not Latin-1\n";
138 print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE";
142 print "not " if defined charnames::viacode(0x0590);
148 sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330";
152 defined charnames::vianame("NONE SUCH");
157 # check that caching at least hasn't broken anything
159 print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE";
163 sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330";
168 print "not " unless "\N{CHARACTER TABULATION}" eq "\t";
171 print "not " unless "\N{ESCAPE}" eq "\e";
174 print "not " unless "\N{NULL}" eq "\c@";
179 print "not " unless "\N{CARRIAGE RETURN (CR)}" eq "\n";
182 print "not " unless "\N{CARRIAGE RETURN}" eq "\n";
185 print "not " unless "\N{CR}" eq "\n";
190 print "not " unless "\N{LINE FEED (LF)}" eq "\n";
193 print "not " unless "\N{LINE FEED}" eq "\n";
196 print "not " unless "\N{LF}" eq "\n";
200 my $nel = ord("A") == 193 ? qr/^(?:\x15|\x25)$/ : qr/^\x85$/;
202 print "not " unless "\N{NEXT LINE (NEL)}" =~ $nel;
205 print "not " unless "\N{NEXT LINE}" =~ $nel;
208 print "not " unless "\N{NEL}" =~ $nel;
211 print "not " unless "\N{BYTE ORDER MARK}" eq chr(0xFEFF);
214 print "not " unless "\N{BOM}" eq chr(0xFEFF);
218 use warnings 'deprecated';
220 print "not " unless "\N{HORIZONTAL TABULATION}" eq "\t";
223 print "not " unless grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN;
226 no warnings 'deprecated';
228 print "not " unless "\N{VERTICAL TABULATION}" eq "\013";
231 print "not " if grep { /"VERTICAL TABULATION" is deprecated/ } @WARN;
235 print "not " unless charnames::viacode(0xFEFF) eq "ZERO WIDTH NO-BREAK SPACE";
240 print "not " unless ord("\N{BOM}") == 0xFEFF;
244 print "not " unless ord("\N{ZWNJ}") == 0x200C;
247 print "not " unless ord("\N{ZWJ}") == 0x200D;
250 print "not " unless "\N{U+263A}" eq "\N{WHITE SMILING FACE}";
255 0x3093 == charnames::vianame("HIRAGANA LETTER N");
259 0x0397 == charnames::vianame("GREEK CAPITAL LETTER ETA");
263 print "not " if defined charnames::viacode(0x110000);
266 print "not " if grep { /you asked for U+110000/ } @WARN;
270 # ---- Alias extensions
272 my $tmpfile = "tmp0000";
273 my $alifile = "../lib/unicore/xyzzy_alias.pl";
275 1 while -e ++$tmpfile;
276 END { if ($tmpfile) { 1 while unlink $tmpfile; } }
280 @prgs = split "\n########\n", <DATA>;
285 my ($code, $exp) = ((split m/\nEXPECT\n/), '$');
286 my ($prog, $fil) = ((split m/\nFILE\n/, $code), "");
287 open my $tmp, "> $tmpfile" or die "Could not open $tmpfile: $!";
288 print $tmp $prog, "\n";
289 close $tmp or die "Could not close $tmpfile: $!";
292 open my $ali, "> $alifile" or die "Could not open $alifile: $!";
294 close $ali or die "Could not close $alifile: $!";
296 my $res = runperl( switches => $switch,
297 progfile => $tmpfile,
300 $res =~ s/[\r\n]+$//;
301 $res =~ s/tmp\d+/-/g; # fake $prog from STDIN
302 $res =~ s/\n%[A-Z]+-[SIWEF]-.*$// # clip off DCL status msg
304 $exp =~ s/[\r\n]+$//;
305 if ($^O eq "MacOS") {
306 $exp =~ s{(\./)?abc\.pm}{:abc.pm}g;
307 $exp =~ s{./abc} {:abc}g;
309 my $pfx = ($res =~ s/^PREFIX\n//);
310 my $rexp = qr{^$exp};
311 if ($res =~ s/^SKIPPED\n//) {
314 elsif (($pfx and $res !~ /^\Q$expected/) or
315 (!$pfx and $res !~ $rexp)) {
323 print "ok ", ++$i, "\n";
324 1 while unlink $tmpfile;
326 1 while unlink $alifile;
331 use charnames ":scoobydoo";
332 "Here: \N{e_ACUTE}!\n";
334 unsupported special ':scoobydoo' in charnames at
336 # wrong type of alias (missing colon)
337 use charnames "alias";
338 "Here: \N{e_ACUTE}!\n";
340 Unknown charname 'e_ACUTE' at
342 # alias without an argument
343 use charnames ":alias";
344 "Here: \N{e_ACUTE}!\n";
346 :alias needs an argument in charnames at
349 use charnames ":alias" => ":full";
350 "Here: \N{e_ACUTE}!\n";
352 :alias cannot use existing pragma :full \(reversed order\?\) at
354 # alias with hashref but no :full
355 use charnames ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
356 "Here: \N{e_ACUTE}!\n";
358 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
360 # alias with hashref but with :short
361 use charnames ":short", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
362 "Here: \N{e_ACUTE}!\n";
364 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
366 # alias with hashref to :full OK
367 use charnames ":full", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
368 "Here: \N{e_ACUTE}!\n";
372 # alias with hashref to :short but using :full
373 use charnames ":full", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
374 "Here: \N{e_ACUTE}!\n";
376 Unknown charname 'LATIN:e WITH ACUTE' at
378 # alias with hashref to :short OK
379 use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
380 "Here: \N{e_ACUTE}!\n";
384 # alias with bad hashref
385 use charnames ":short", ":alias" => "e_ACUTE";
386 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
388 unicore/e_ACUTE_alias.pl cannot be used as alias file for charnames at
390 # alias with arrayref
391 use charnames ":short", ":alias" => [ e_ACUTE => "LATIN:e WITH ACUTE" ];
392 "Here: \N{e_ACUTE}!\n";
394 Only HASH reference supported as argument to :alias at
396 # alias with bad hashref
397 use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE", "a_ACUTE" };
398 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
400 Use of uninitialized value in string eq at
402 # alias with hashref two aliases
403 use charnames ":short", ":alias" => {
404 e_ACUTE => "LATIN:e WITH ACUTE",
407 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
409 Unknown charname '' at
411 # alias with hashref two aliases
412 use charnames ":short", ":alias" => {
413 e_ACUTE => "LATIN:e WITH ACUTE",
414 a_ACUTE => "LATIN:a WITH ACUTE",
416 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
420 # alias with hashref using mixed aliasses
421 use charnames ":short", ":alias" => {
422 e_ACUTE => "LATIN:e WITH ACUTE",
423 a_ACUTE => "LATIN SMALL LETTER A WITH ACUT",
425 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
427 Unknown charname 'LATIN SMALL LETTER A WITH ACUT' at
429 # alias with hashref using mixed aliasses
430 use charnames ":short", ":alias" => {
431 e_ACUTE => "LATIN:e WITH ACUTE",
432 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
434 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
436 Unknown charname 'LATIN SMALL LETTER A WITH ACUTE' at
438 # alias with hashref using mixed aliasses
439 use charnames ":full", ":alias" => {
440 e_ACUTE => "LATIN:e WITH ACUTE",
441 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
443 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
445 Unknown charname 'LATIN:e WITH ACUTE' at
447 # alias with nonexisting file
448 use charnames ":full", ":alias" => "xyzzy";
449 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
451 unicore/xyzzy_alias.pl cannot be used as alias file for charnames at
453 # alias with bad file name
454 use charnames ":full", ":alias" => "xy 7-";
455 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
457 Charnames alias files can only have identifier characters at
459 # alias with non_absolute (existing) file name (which it should /not/ use)
460 use charnames ":full", ":alias" => "perl";
461 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
463 unicore/perl_alias.pl cannot be used as alias file for charnames at
465 # alias with bad file
466 use charnames ":full", ":alias" => "xyzzy";
467 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
472 unicore/xyzzy_alias.pl did not return a \(valid\) list of alias pairs at
474 # alias with file with empty list
475 use charnames ":full", ":alias" => "xyzzy";
476 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
481 Unknown charname 'e_ACUTE' at
483 # alias with file OK but file has :short aliasses
484 use charnames ":full", ":alias" => "xyzzy";
485 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
488 ( e_ACUTE => "LATIN:e WITH ACUTE",
489 a_ACUTE => "LATIN:a WITH ACUTE",
492 Unknown charname 'LATIN:e WITH ACUTE' at
494 # alias with :short and file OK
495 use charnames ":short", ":alias" => "xyzzy";
496 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
499 ( e_ACUTE => "LATIN:e WITH ACUTE",
500 a_ACUTE => "LATIN:a WITH ACUTE",
505 # alias with :short and file OK has :long aliasses
506 use charnames ":short", ":alias" => "xyzzy";
507 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
510 ( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
511 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
514 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
516 # alias with file implicit :full but file has :short aliasses
517 use charnames ":alias" => ":xyzzy";
518 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
521 ( e_ACUTE => "LATIN:e WITH ACUTE",
522 a_ACUTE => "LATIN:a WITH ACUTE",
525 Unknown charname 'LATIN:e WITH ACUTE' at
527 # alias with file implicit :full and file has :long aliasses
528 use charnames ":alias" => ":xyzzy";
529 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
532 ( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
533 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",