Commit | Line | Data |
---|---|---|
423cee85 JH |
1 | #!./perl |
2 | ||
52ea3e69 JH |
3 | my @WARN; |
4 | ||
423cee85 JH |
5 | BEGIN { |
6 | unless(grep /blib/, @INC) { | |
7 | chdir 't' if -d 't'; | |
20822f61 | 8 | @INC = '../lib'; |
423cee85 | 9 | } |
52ea3e69 | 10 | $SIG{__WARN__} = sub { push @WARN, @_ }; |
423cee85 JH |
11 | } |
12 | ||
13 | $| = 1; | |
822ebcc8 | 14 | |
51b0dbc4 | 15 | print "1..46\n"; |
423cee85 JH |
16 | |
17 | use charnames ':full'; | |
18 | ||
93979888 | 19 | print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here!?"; |
423cee85 JH |
20 | print "ok 1\n"; |
21 | ||
c82a54e6 | 22 | { |
5d9a6404 | 23 | use bytes; # TEST -utf8 can switch utf8 on |
c82a54e6 IZ |
24 | |
25 | print "# \$res=$res \$\@='$@'\nnot " | |
26 | if $res = eval <<'EOE' | |
423cee85 | 27 | use charnames ":full"; |
4a2d328f | 28 | "Here: \N{CYRILLIC SMALL LETTER BE}!"; |
423cee85 JH |
29 | 1 |
30 | EOE | |
c82a54e6 IZ |
31 | or $@ !~ /above 0xFF/; |
32 | print "ok 2\n"; | |
33 | # print "# \$res=$res \$\@='$@'\n"; | |
423cee85 | 34 | |
c82a54e6 IZ |
35 | print "# \$res=$res \$\@='$@'\nnot " |
36 | if $res = eval <<'EOE' | |
423cee85 | 37 | use charnames 'cyrillic'; |
4a2d328f | 38 | "Here: \N{Be}!"; |
423cee85 JH |
39 | 1 |
40 | EOE | |
c82a54e6 IZ |
41 | or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/; |
42 | print "ok 3\n"; | |
43 | } | |
423cee85 JH |
44 | |
45 | # If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt | |
210db7fc PP |
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"; | |
51 | } | |
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"; | |
58 | } | |
c5cc3500 GS |
59 | |
60 | sub to_bytes { | |
f9a63242 | 61 | pack"a*", shift; |
c5cc3500 GS |
62 | } |
63 | ||
423cee85 JH |
64 | { |
65 | use charnames ':full'; | |
423cee85 | 66 | |
c5cc3500 | 67 | print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be; |
423cee85 JH |
68 | print "ok 4\n"; |
69 | ||
70 | use charnames qw(cyrillic greek :short); | |
71 | ||
c5cc3500 | 72 | print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}") |
423cee85 JH |
73 | eq "$encoded_be,$encoded_alpha,$encoded_bet"; |
74 | print "ok 5\n"; | |
75 | } | |
e1992b6d GS |
76 | |
77 | { | |
78 | use charnames ':full'; | |
79 | print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}"; | |
80 | print "ok 6\n"; | |
81 | print "not " unless length("\x{263a}") == 1; | |
82 | print "ok 7\n"; | |
83 | print "not " unless length("\N{WHITE SMILING FACE}") == 1; | |
84 | print "ok 8\n"; | |
85 | print "not " unless sprintf("%vx", "\x{263a}") eq "263a"; | |
86 | print "ok 9\n"; | |
87 | print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a"; | |
88 | print "ok 10\n"; | |
f08d6ad9 GS |
89 | print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a"; |
90 | print "ok 11\n"; | |
91 | print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a"; | |
92 | print "ok 12\n"; | |
e1992b6d | 93 | } |
c00525d4 SP |
94 | |
95 | { | |
96 | use charnames qw(:full); | |
55eda711 | 97 | use utf8; |
c00525d4 SP |
98 | |
99 | my $x = "\x{221b}"; | |
100 | my $named = "\N{CUBE ROOT}"; | |
101 | ||
102 | print "not " unless ord($x) == ord($named); | |
103 | print "ok 13\n"; | |
104 | } | |
105 | ||
f9a63242 JH |
106 | { |
107 | use charnames qw(:full); | |
55eda711 | 108 | use utf8; |
f9a63242 JH |
109 | print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}"; |
110 | print "ok 14\n"; | |
111 | } | |
112 | ||
b896c7a5 A |
113 | { |
114 | use charnames ':full'; | |
115 | ||
116 | print "not " | |
117 | unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng; | |
118 | print "ok 15\n"; | |
4765795a | 119 | } |
b896c7a5 | 120 | |
4765795a JH |
121 | { |
122 | # 20001114.001 | |
123 | ||
4c53e876 | 124 | no utf8; # naked Latin-1 |
3ba0e062 | 125 | |
4765795a JH |
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; | |
130 | print "ok 16\n"; | |
131 | } else { | |
132 | print "ok 16 # Skip: not Latin-1\n"; | |
133 | } | |
b896c7a5 A |
134 | } |
135 | ||
daf0d493 JH |
136 | { |
137 | print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE"; | |
138 | print "ok 17\n"; | |
139 | ||
a23c04e4 | 140 | # Unused Hebrew. |
11881cb4 | 141 | print "not " if defined charnames::viacode(0x0590); |
daf0d493 JH |
142 | print "ok 18\n"; |
143 | } | |
144 | ||
145 | { | |
146 | print "not " unless | |
51b0dbc4 | 147 | sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330"; |
daf0d493 JH |
148 | print "ok 19\n"; |
149 | ||
150 | print "not " if | |
151 | defined charnames::vianame("NONE SUCH"); | |
152 | print "ok 20\n"; | |
153 | } | |
4e2cda5d JH |
154 | |
155 | { | |
156 | # check that caching at least hasn't broken anything | |
157 | ||
158 | print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE"; | |
159 | print "ok 21\n"; | |
160 | ||
161 | print "not " unless | |
51b0dbc4 | 162 | sprintf("%04X", charnames::vianame("GOTHIC LETTER AHSA")) eq "10330"; |
4e2cda5d JH |
163 | print "ok 22\n"; |
164 | ||
165 | } | |
301a3cda | 166 | |
822ebcc8 | 167 | print "not " unless "\N{CHARACTER TABULATION}" eq "\t"; |
301a3cda JH |
168 | print "ok 23\n"; |
169 | ||
170 | print "not " unless "\N{ESCAPE}" eq "\e"; | |
171 | print "ok 24\n"; | |
172 | ||
173 | print "not " unless "\N{NULL}" eq "\c@"; | |
174 | print "ok 25\n"; | |
175 | ||
eb380778 JH |
176 | if ($^O eq 'MacOS') |
177 | { | |
178 | print "not " unless "\N{CARRIAGE RETURN (CR)}" eq "\n"; | |
179 | print "ok 26\n"; | |
180 | ||
181 | print "not " unless "\N{CARRIAGE RETURN}" eq "\n"; | |
182 | print "ok 27\n"; | |
183 | ||
184 | print "not " unless "\N{CR}" eq "\n"; | |
185 | print "ok 28\n"; | |
186 | } | |
187 | else | |
188 | { | |
189 | print "not " unless "\N{LINE FEED (LF)}" eq "\n"; | |
190 | print "ok 26\n"; | |
52ea3e69 | 191 | |
eb380778 JH |
192 | print "not " unless "\N{LINE FEED}" eq "\n"; |
193 | print "ok 27\n"; | |
52ea3e69 | 194 | |
eb380778 JH |
195 | print "not " unless "\N{LF}" eq "\n"; |
196 | print "ok 28\n"; | |
197 | } | |
52ea3e69 | 198 | |
a2e77dd4 JH |
199 | my $nel = ord("A") == 193 ? qr/^(?:\x15|\x25)$/ : qr/^\x85$/; |
200 | ||
201 | print "not " unless "\N{NEXT LINE (NEL)}" =~ $nel; | |
52ea3e69 JH |
202 | print "ok 29\n"; |
203 | ||
a2e77dd4 | 204 | print "not " unless "\N{NEXT LINE}" =~ $nel; |
52ea3e69 JH |
205 | print "ok 30\n"; |
206 | ||
a2e77dd4 | 207 | print "not " unless "\N{NEL}" =~ $nel; |
51e9e896 PN |
208 | print "ok 31\n"; |
209 | ||
274085e3 | 210 | print "not " unless "\N{BYTE ORDER MARK}" eq chr(0xFEFF); |
51e9e896 PN |
211 | print "ok 32\n"; |
212 | ||
d7d589a8 | 213 | print "not " unless "\N{BOM}" eq chr(0xFEFF); |
51e9e896 PN |
214 | print "ok 33\n"; |
215 | ||
52ea3e69 JH |
216 | { |
217 | use warnings 'deprecated'; | |
218 | ||
219 | print "not " unless "\N{HORIZONTAL TABULATION}" eq "\t"; | |
51e9e896 | 220 | print "ok 34\n"; |
52ea3e69 JH |
221 | |
222 | print "not " unless grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN; | |
51e9e896 | 223 | print "ok 35\n"; |
822ebcc8 | 224 | |
52ea3e69 JH |
225 | no warnings 'deprecated'; |
226 | ||
227 | print "not " unless "\N{VERTICAL TABULATION}" eq "\013"; | |
51e9e896 | 228 | print "ok 36\n"; |
52ea3e69 JH |
229 | |
230 | print "not " if grep { /"VERTICAL TABULATION" is deprecated/ } @WARN; | |
51e9e896 | 231 | print "ok 37\n"; |
52ea3e69 | 232 | } |
822ebcc8 | 233 | |
274085e3 | 234 | print "not " unless charnames::viacode(0xFEFF) eq "ZERO WIDTH NO-BREAK SPACE"; |
a23c04e4 JH |
235 | print "ok 38\n"; |
236 | ||
872c91ae JH |
237 | { |
238 | use warnings; | |
239 | print "not " unless ord("\N{BOM}") == 0xFEFF; | |
240 | print "ok 39\n"; | |
241 | } | |
242 | ||
24b5d5cc JH |
243 | print "not " unless ord("\N{ZWNJ}") == 0x200C; |
244 | print "ok 40\n"; | |
245 | ||
246 | print "not " unless ord("\N{ZWJ}") == 0x200D; | |
247 | print "ok 41\n"; | |
dbc0d4f2 JH |
248 | |
249 | print "not " unless "\N{U+263A}" eq "\N{WHITE SMILING FACE}"; | |
250 | print "ok 42\n"; | |
251 | ||
51b0dbc4 TS |
252 | { |
253 | print "not " unless | |
254 | 0x3093 == charnames::vianame("HIRAGANA LETTER N"); | |
255 | print "ok 43\n"; | |
256 | ||
257 | print "not " unless | |
258 | 0x0397 == charnames::vianame("GREEK CAPITAL LETTER ETA"); | |
259 | print "ok 44\n"; | |
260 | } | |
261 | ||
00d835f2 | 262 | print "not " if defined charnames::viacode(0x110000); |
51b0dbc4 | 263 | print "ok 45\n"; |
00d835f2 JH |
264 | |
265 | print "not " if grep { /you asked for U+110000/ } @WARN; | |
51b0dbc4 | 266 | print "ok 46\n"; |