Commit | Line | Data |
423cee85 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | unless(grep /blib/, @INC) { |
5 | chdir 't' if -d 't'; |
20822f61 |
6 | @INC = '../lib'; |
423cee85 |
7 | } |
8 | } |
9 | |
10 | $| = 1; |
822ebcc8 |
11 | |
301a3cda |
12 | print "1..25\n"; |
423cee85 |
13 | |
14 | use charnames ':full'; |
15 | |
93979888 |
16 | print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here!?"; |
423cee85 |
17 | print "ok 1\n"; |
18 | |
c82a54e6 |
19 | { |
5d9a6404 |
20 | use bytes; # TEST -utf8 can switch utf8 on |
c82a54e6 |
21 | |
22 | print "# \$res=$res \$\@='$@'\nnot " |
23 | if $res = eval <<'EOE' |
423cee85 |
24 | use charnames ":full"; |
4a2d328f |
25 | "Here: \N{CYRILLIC SMALL LETTER BE}!"; |
423cee85 |
26 | 1 |
27 | EOE |
c82a54e6 |
28 | or $@ !~ /above 0xFF/; |
29 | print "ok 2\n"; |
30 | # print "# \$res=$res \$\@='$@'\n"; |
423cee85 |
31 | |
c82a54e6 |
32 | print "# \$res=$res \$\@='$@'\nnot " |
33 | if $res = eval <<'EOE' |
423cee85 |
34 | use charnames 'cyrillic'; |
4a2d328f |
35 | "Here: \N{Be}!"; |
423cee85 |
36 | 1 |
37 | EOE |
c82a54e6 |
38 | or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/; |
39 | print "ok 3\n"; |
40 | } |
423cee85 |
41 | |
42 | # If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt |
210db7fc |
43 | if (ord('A') == 65) { # as on ASCII or UTF-8 machines |
44 | $encoded_be = "\320\261"; |
45 | $encoded_alpha = "\316\261"; |
46 | $encoded_bet = "\327\221"; |
47 | $encoded_deseng = "\360\220\221\215"; |
48 | } |
49 | else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since |
50 | # UTF-EBCDIC is codepage specific) |
51 | $encoded_be = "\270\102\130"; |
52 | $encoded_alpha = "\264\130"; |
53 | $encoded_bet = "\270\125\130"; |
54 | $encoded_deseng = "\336\102\103\124"; |
55 | } |
c5cc3500 |
56 | |
57 | sub to_bytes { |
f9a63242 |
58 | pack"a*", shift; |
c5cc3500 |
59 | } |
60 | |
423cee85 |
61 | { |
62 | use charnames ':full'; |
423cee85 |
63 | |
c5cc3500 |
64 | print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be; |
423cee85 |
65 | print "ok 4\n"; |
66 | |
67 | use charnames qw(cyrillic greek :short); |
68 | |
c5cc3500 |
69 | print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}") |
423cee85 |
70 | eq "$encoded_be,$encoded_alpha,$encoded_bet"; |
71 | print "ok 5\n"; |
72 | } |
e1992b6d |
73 | |
74 | { |
75 | use charnames ':full'; |
76 | print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}"; |
77 | print "ok 6\n"; |
78 | print "not " unless length("\x{263a}") == 1; |
79 | print "ok 7\n"; |
80 | print "not " unless length("\N{WHITE SMILING FACE}") == 1; |
81 | print "ok 8\n"; |
82 | print "not " unless sprintf("%vx", "\x{263a}") eq "263a"; |
83 | print "ok 9\n"; |
84 | print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a"; |
85 | print "ok 10\n"; |
f08d6ad9 |
86 | print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a"; |
87 | print "ok 11\n"; |
88 | print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a"; |
89 | print "ok 12\n"; |
e1992b6d |
90 | } |
c00525d4 |
91 | |
92 | { |
93 | use charnames qw(:full); |
55eda711 |
94 | use utf8; |
c00525d4 |
95 | |
96 | my $x = "\x{221b}"; |
97 | my $named = "\N{CUBE ROOT}"; |
98 | |
99 | print "not " unless ord($x) == ord($named); |
100 | print "ok 13\n"; |
101 | } |
102 | |
f9a63242 |
103 | { |
104 | use charnames qw(:full); |
55eda711 |
105 | use utf8; |
f9a63242 |
106 | print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}"; |
107 | print "ok 14\n"; |
108 | } |
109 | |
b896c7a5 |
110 | { |
111 | use charnames ':full'; |
112 | |
113 | print "not " |
114 | unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng; |
115 | print "ok 15\n"; |
4765795a |
116 | } |
b896c7a5 |
117 | |
4765795a |
118 | { |
119 | # 20001114.001 |
120 | |
4c53e876 |
121 | no utf8; # naked Latin-1 |
3ba0e062 |
122 | |
4765795a |
123 | if (ord("Ä") == 0xc4) { # Try to do this only on Latin-1. |
124 | use charnames ':full'; |
125 | my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}"; |
126 | print "not " unless $text eq "\xc4" && ord($text) == 0xc4; |
127 | print "ok 16\n"; |
128 | } else { |
129 | print "ok 16 # Skip: not Latin-1\n"; |
130 | } |
b896c7a5 |
131 | } |
132 | |
daf0d493 |
133 | { |
134 | print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE"; |
135 | print "ok 17\n"; |
136 | |
137 | print "not " if defined charnames::viacode(0x0590); # unused Hebrew |
138 | print "ok 18\n"; |
139 | } |
140 | |
141 | { |
142 | print "not " unless |
143 | sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; |
144 | print "ok 19\n"; |
145 | |
146 | print "not " if |
147 | defined charnames::vianame("NONE SUCH"); |
148 | print "ok 20\n"; |
149 | } |
4e2cda5d |
150 | |
151 | { |
152 | # check that caching at least hasn't broken anything |
153 | |
154 | print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE"; |
155 | print "ok 21\n"; |
156 | |
157 | print "not " unless |
158 | sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; |
159 | print "ok 22\n"; |
160 | |
161 | } |
301a3cda |
162 | |
822ebcc8 |
163 | print "not " unless "\N{CHARACTER TABULATION}" eq "\t"; |
301a3cda |
164 | print "ok 23\n"; |
165 | |
166 | print "not " unless "\N{ESCAPE}" eq "\e"; |
167 | print "ok 24\n"; |
168 | |
169 | print "not " unless "\N{NULL}" eq "\c@"; |
170 | print "ok 25\n"; |
171 | |
822ebcc8 |
172 | # TODO: support 3.1 names, BOM. Generic aliasing? |
173 | |
174 | |