6 unless(grep /blib/, @INC) {
10 $SIG{__WARN__} = sub { push @WARN, @_ };
17 use charnames ':full';
19 print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here!?";
23 use bytes; # TEST -utf8 can switch utf8 on
25 print "# \$res=$res \$\@='$@'\nnot "
26 if $res = eval <<'EOE'
27 use charnames ":full";
28 "Here: \N{CYRILLIC SMALL LETTER BE}!";
31 or $@ !~ /above 0xFF/;
33 # print "# \$res=$res \$\@='$@'\n";
35 print "# \$res=$res \$\@='$@'\nnot "
36 if $res = eval <<'EOE'
37 use charnames 'cyrillic';
41 or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
45 # If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
46 if (ord('A') == 65) { # as on ASCII or UTF-8 machines
47 $encoded_be = "\320\261";
48 $encoded_alpha = "\316\261";
49 $encoded_bet = "\327\221";
50 $encoded_deseng = "\360\220\221\215";
52 else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
53 # UTF-EBCDIC is codepage specific)
54 $encoded_be = "\270\102\130";
55 $encoded_alpha = "\264\130";
56 $encoded_bet = "\270\125\130";
57 $encoded_deseng = "\336\102\103\124";
65 use charnames ':full';
67 print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be;
70 use charnames qw(cyrillic greek :short);
72 print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}")
73 eq "$encoded_be,$encoded_alpha,$encoded_bet";
78 use charnames ':full';
79 print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}";
81 print "not " unless length("\x{263a}") == 1;
83 print "not " unless length("\N{WHITE SMILING FACE}") == 1;
85 print "not " unless sprintf("%vx", "\x{263a}") eq "263a";
87 print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a";
89 print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a";
91 print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a";
96 use charnames qw(:full);
100 my $named = "\N{CUBE ROOT}";
102 print "not " unless ord($x) == ord($named);
107 use charnames qw(:full);
109 print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}";
114 use charnames ':full';
117 unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng;
124 no utf8; # naked Latin-1
126 if (ord("Ä") == 0xc4) { # Try to do this only on Latin-1.
127 use charnames ':full';
128 my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
129 print "not " unless $text eq "\xc4" && ord($text) == 0xc4;
132 print "ok 16 # Skip: not Latin-1\n";
137 print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE";
141 print "not " if defined charnames::viacode(0x0590);
147 sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330";
151 defined charnames::vianame("NONE SUCH");
156 # check that caching at least hasn't broken anything
158 print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE";
162 sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330";
167 print "not " unless "\N{CHARACTER TABULATION}" eq "\t";
170 print "not " unless "\N{ESCAPE}" eq "\e";
173 print "not " unless "\N{NULL}" eq "\c@";
178 print "not " unless "\N{CARRIAGE RETURN (CR)}" eq "\n";
181 print "not " unless "\N{CARRIAGE RETURN}" eq "\n";
184 print "not " unless "\N{CR}" eq "\n";
189 print "not " unless "\N{LINE FEED (LF)}" eq "\n";
192 print "not " unless "\N{LINE FEED}" eq "\n";
195 print "not " unless "\N{LF}" eq "\n";
199 my $nel = ord("A") == 193 ? qr/^(?:\x15|\x25)$/ : qr/^\x85$/;
201 print "not " unless "\N{NEXT LINE (NEL)}" =~ $nel;
204 print "not " unless "\N{NEXT LINE}" =~ $nel;
207 print "not " unless "\N{NEL}" =~ $nel;
210 print "not " unless "\N{BYTE ORDER MARK}" eq chr(0xFEFF);
213 print "not " unless "\N{BOM}" eq chr(0xFEFF);
217 use warnings 'deprecated';
219 print "not " unless "\N{HORIZONTAL TABULATION}" eq "\t";
222 print "not " unless grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN;
225 no warnings 'deprecated';
227 print "not " unless "\N{VERTICAL TABULATION}" eq "\013";
230 print "not " if grep { /"VERTICAL TABULATION" is deprecated/ } @WARN;
234 print "not " unless charnames::viacode(0xFEFF) eq "ZERO WIDTH NO-BREAK SPACE";
239 print "not " unless ord("\N{BOM}") == 0xFEFF;
243 print "not " unless ord("\N{ZWNJ}") == 0x200C;
246 print "not " unless ord("\N{ZWJ}") == 0x200D;
249 print "not " unless "\N{U+263A}" eq "\N{WHITE SMILING FACE}";
254 0x3093 == charnames::vianame("HIRAGANA LETTER N");
258 0x0397 == charnames::vianame("GREEK CAPITAL LETTER ETA");
262 print "not " if defined charnames::viacode(0x110000);
265 print "not " if grep { /you asked for U+110000/ } @WARN;
269 # ---- Alias extensions
271 my $tmpfile = "tmp0000";
272 my $alifile = "../lib/unicore/xyzzy_alias.pl";
274 1 while -e ++$tmpfile;
275 END { if ($tmpfile) { 1 while unlink $tmpfile; } }
279 @prgs = split "\n########\n", <DATA>;
284 my ($code, $exp) = ((split m/\nEXPECT\n/), '$');
285 my ($prog, $fil) = ((split m/\nFILE\n/, $code), "");
286 open my $tmp, "> $tmpfile" or die "Could not open $tmpfile: $!";
287 print $tmp $prog, "\n";
288 close $tmp or die "Could not close $tmpfile: $!";
291 open my $ali, "> $alifile" or die "Could not open $alifile: $!";
293 close $ali or die "Could not close $alifile: $!";
296 $^O eq "MSWin32" ? `.\\perl -I../lib $switch $tmpfile 2>&1` :
297 $^O eq "NetWare" ? `perl -I../lib $switch $tmpfile 2>&1` :
298 $^O eq "MacOS" ? `$^X -I::lib -MMac::err=unix $switch $tmpfile` :
299 `./perl -I. -I../lib $switch $tmpfile 2>&1`;
301 $res =~ s/[\r\n]+$//;
302 $res =~ s/tmp\d+/-/g; # fake $prog from STDIN
303 $res =~ s/\n%[A-Z]+-[SIWEF]-.*$// # clip off DCL status msg
305 $exp =~ s/[\r\n]+$//;
306 if ($^O eq "MacOS") {
307 $exp =~ s{(\./)?abc\.pm}{:abc.pm}g;
308 $exp =~ s{./abc} {:abc}g;
310 my $pfx = ($res =~ s/^PREFIX\n//);
311 my $rexp = qr{^$exp};
312 if ($res =~ s/^SKIPPED\n//) {
315 elsif (($pfx and $res !~ /^\Q$expected/) or
316 (!$pfx and $res !~ $rexp)) {
324 print "ok ", ++$i, "\n";
325 1 while unlink $tmpfile;
327 1 while unlink $alifile;
331 # wrong type of alias (missing colon)
332 use charnames "alias";
333 "Here: \N{e_ACUTE}!\n";
335 Unknown charname 'e_ACUTE' at
337 # alias without an argument
338 use charnames ":alias";
339 "Here: \N{e_ACUTE}!\n";
341 Unknown charname 'e_ACUTE' at
343 # alias with hashref but no :full
344 use charnames ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
345 "Here: \N{e_ACUTE}!\n";
347 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
349 # alias with hashref but with :short
350 use charnames ":short", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
351 "Here: \N{e_ACUTE}!\n";
353 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
355 # alias with hashref to :full OK
356 use charnames ":full", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
357 "Here: \N{e_ACUTE}!\n";
361 # alias with hashref to :short but using :full
362 use charnames ":full", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
363 "Here: \N{e_ACUTE}!\n";
365 Unknown charname 'LATIN:e WITH ACUTE' at
367 # alias with hashref to :short OK
368 use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
369 "Here: \N{e_ACUTE}!\n";
373 # alias with bad hashref
374 use charnames ":short", ":alias" => "e_ACUTE";
375 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
377 Odd number of elements in anonymous hash at
379 # alias with arrayref
380 use charnames ":short", ":alias" => [ e_ACUTE => "LATIN:e WITH ACUTE" ];
381 "Here: \N{e_ACUTE}!\n";
383 Only HASH reference supported as argument to :alias at
385 # alias with bad hashref
386 use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE", "a_ACUTE" };
387 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
389 Use of uninitialized value in string eq at
391 # alias with hashref two aliases
392 use charnames ":short", ":alias" => {
393 e_ACUTE => "LATIN:e WITH ACUTE",
396 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
398 Unknown charname '' at
400 # alias with hashref two aliases
401 use charnames ":short", ":alias" => {
402 e_ACUTE => "LATIN:e WITH ACUTE",
403 a_ACUTE => "LATIN:a WITH ACUTE",
405 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
409 # alias with hashref using mixed aliasses
410 use charnames ":short", ":alias" => {
411 e_ACUTE => "LATIN:e WITH ACUTE",
412 a_ACUTE => "LATIN SMALL LETTER A WITH ACUT",
414 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
416 Unknown charname 'LATIN SMALL LETTER A WITH ACUT' at
418 # alias with hashref using mixed aliasses
419 use charnames ":short", ":alias" => {
420 e_ACUTE => "LATIN:e WITH ACUTE",
421 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
423 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
425 Unknown charname 'LATIN SMALL LETTER A WITH ACUTE' at
427 # alias with hashref using mixed aliasses
428 use charnames ":full", ":alias" => {
429 e_ACUTE => "LATIN:e WITH ACUTE",
430 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
432 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
434 Unknown charname 'LATIN:e WITH ACUTE' at
436 # alias with nonexisting file
437 use charnames ":full", ":alias" => "xyzzy";
438 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
440 Odd number of elements in anonymous hash at
442 # alias with bad file
443 use charnames ":full", ":alias" => "xyzzy";
444 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
449 Odd number of elements in anonymous hash at
451 # alias with file with empty list
452 use charnames ":full", ":alias" => "xyzzy";
453 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
458 Unknown charname 'e_ACUTE' at
460 # alias with file OK but file has :short aliasses
461 use charnames ":full", ":alias" => "xyzzy";
462 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
465 ( e_ACUTE => "LATIN:e WITH ACUTE",
466 a_ACUTE => "LATIN:a WITH ACUTE",
469 Unknown charname 'LATIN:e WITH ACUTE' at
471 # alias with :short and file OK
472 use charnames ":short", ":alias" => "xyzzy";
473 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
476 ( e_ACUTE => "LATIN:e WITH ACUTE",
477 a_ACUTE => "LATIN:a WITH ACUTE",
482 # alias with :short and file OK has :long aliasses
483 use charnames ":short", ":alias" => "xyzzy";
484 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
487 ( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
488 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
491 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
493 # alias with file implicit :full but file has :short aliasses
494 use charnames ":alias" => ":xyzzy";
495 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
498 ( e_ACUTE => "LATIN:e WITH ACUTE",
499 a_ACUTE => "LATIN:a WITH ACUTE",
502 Unknown charname 'LATIN:e WITH ACUTE' at
504 # alias with file implicit :full and file has :long aliasses
505 use charnames ":alias" => ":xyzzy";
506 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
509 ( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
510 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",