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;
332 use charnames ":scoobydoo";
333 "Here: \N{e_ACUTE}!\n";
335 unsupported special ':scoobydoo' in charnames at
337 # wrong type of alias (missing colon)
338 use charnames "alias";
339 "Here: \N{e_ACUTE}!\n";
341 Unknown charname 'e_ACUTE' at
343 # alias without an argument
344 use charnames ":alias";
345 "Here: \N{e_ACUTE}!\n";
347 :alias needs an argument in charnames at
350 use charnames ":alias" => ":full";
351 "Here: \N{e_ACUTE}!\n";
353 :alias cannot use existing pragma :full \(reversed order\?\) at
355 # alias with hashref but no :full
356 use charnames ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
357 "Here: \N{e_ACUTE}!\n";
359 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
361 # alias with hashref but with :short
362 use charnames ":short", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
363 "Here: \N{e_ACUTE}!\n";
365 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
367 # alias with hashref to :full OK
368 use charnames ":full", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
369 "Here: \N{e_ACUTE}!\n";
373 # alias with hashref to :short but using :full
374 use charnames ":full", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
375 "Here: \N{e_ACUTE}!\n";
377 Unknown charname 'LATIN:e WITH ACUTE' at
379 # alias with hashref to :short OK
380 use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
381 "Here: \N{e_ACUTE}!\n";
385 # alias with bad hashref
386 use charnames ":short", ":alias" => "e_ACUTE";
387 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
389 unicore/e_ACUTE_alias.pl cannot be used as alias file for charnames at
391 # alias with arrayref
392 use charnames ":short", ":alias" => [ e_ACUTE => "LATIN:e WITH ACUTE" ];
393 "Here: \N{e_ACUTE}!\n";
395 Only HASH reference supported as argument to :alias at
397 # alias with bad hashref
398 use charnames ":short", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE", "a_ACUTE" };
399 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
401 Use of uninitialized value in string eq at
403 # alias with hashref two aliases
404 use charnames ":short", ":alias" => {
405 e_ACUTE => "LATIN:e WITH ACUTE",
408 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
410 Unknown charname '' at
412 # alias with hashref two aliases
413 use charnames ":short", ":alias" => {
414 e_ACUTE => "LATIN:e WITH ACUTE",
415 a_ACUTE => "LATIN:a WITH ACUTE",
417 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
421 # alias with hashref using mixed aliasses
422 use charnames ":short", ":alias" => {
423 e_ACUTE => "LATIN:e WITH ACUTE",
424 a_ACUTE => "LATIN SMALL LETTER A WITH ACUT",
426 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
428 Unknown charname 'LATIN SMALL LETTER A WITH ACUT' at
430 # alias with hashref using mixed aliasses
431 use charnames ":short", ":alias" => {
432 e_ACUTE => "LATIN:e WITH ACUTE",
433 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
435 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
437 Unknown charname 'LATIN SMALL LETTER A WITH ACUTE' at
439 # alias with hashref using mixed aliasses
440 use charnames ":full", ":alias" => {
441 e_ACUTE => "LATIN:e WITH ACUTE",
442 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
444 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
446 Unknown charname 'LATIN:e WITH ACUTE' at
448 # alias with nonexisting file
449 use charnames ":full", ":alias" => "xyzzy";
450 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
452 unicore/xyzzy_alias.pl cannot be used as alias file for charnames at
454 # alias with bad file name
455 use charnames ":full", ":alias" => "xy 7-";
456 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
458 Charnames alias files can only have identifier characters at
460 # alias with non_absolute (existing) file name (which it should /not/ use)
461 use charnames ":full", ":alias" => "perl";
462 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
464 unicore/perl_alias.pl cannot be used as alias file for charnames at
466 # alias with bad file
467 use charnames ":full", ":alias" => "xyzzy";
468 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
473 unicore/xyzzy_alias.pl did not return a \(valid\) list of alias pairs at
475 # alias with file with empty list
476 use charnames ":full", ":alias" => "xyzzy";
477 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
482 Unknown charname 'e_ACUTE' at
484 # alias with file OK but file has :short aliasses
485 use charnames ":full", ":alias" => "xyzzy";
486 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
489 ( e_ACUTE => "LATIN:e WITH ACUTE",
490 a_ACUTE => "LATIN:a WITH ACUTE",
493 Unknown charname 'LATIN:e WITH ACUTE' at
495 # alias with :short and file OK
496 use charnames ":short", ":alias" => "xyzzy";
497 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
500 ( e_ACUTE => "LATIN:e WITH ACUTE",
501 a_ACUTE => "LATIN:a WITH ACUTE",
506 # alias with :short and file OK has :long aliasses
507 use charnames ":short", ":alias" => "xyzzy";
508 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
511 ( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
512 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",
515 Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
517 # alias with file implicit :full but file has :short aliasses
518 use charnames ":alias" => ":xyzzy";
519 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
522 ( e_ACUTE => "LATIN:e WITH ACUTE",
523 a_ACUTE => "LATIN:a WITH ACUTE",
526 Unknown charname 'LATIN:e WITH ACUTE' at
528 # alias with file implicit :full and file has :long aliasses
529 use charnames ":alias" => ":xyzzy";
530 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
533 ( e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
534 a_ACUTE => "LATIN SMALL LETTER A WITH ACUTE",