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 | |
872c91ae | 15 | print "1..39\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 JH |
140 | # Unused Hebrew. |
141 | print "not " unless charnames::viacode(0x0590) eq chr(0xFFFD); | |
daf0d493 JH |
142 | print "ok 18\n"; |
143 | } | |
144 | ||
145 | { | |
146 | print "not " unless | |
147 | sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; | |
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 | |
162 | sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330"; | |
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 | ||
52ea3e69 JH |
176 | print "not " unless "\N{LINE FEED (LF)}" eq "\n"; |
177 | print "ok 26\n"; | |
178 | ||
179 | print "not " unless "\N{LINE FEED}" eq "\n"; | |
180 | print "ok 27\n"; | |
181 | ||
182 | print "not " unless "\N{LF}" eq "\n"; | |
183 | print "ok 28\n"; | |
184 | ||
a2e77dd4 JH |
185 | my $nel = ord("A") == 193 ? qr/^(?:\x15|\x25)$/ : qr/^\x85$/; |
186 | ||
187 | print "not " unless "\N{NEXT LINE (NEL)}" =~ $nel; | |
52ea3e69 JH |
188 | print "ok 29\n"; |
189 | ||
a2e77dd4 | 190 | print "not " unless "\N{NEXT LINE}" =~ $nel; |
52ea3e69 JH |
191 | print "ok 30\n"; |
192 | ||
a2e77dd4 | 193 | print "not " unless "\N{NEL}" =~ $nel; |
51e9e896 PN |
194 | print "ok 31\n"; |
195 | ||
274085e3 | 196 | print "not " unless "\N{BYTE ORDER MARK}" eq chr(0xFEFF); |
51e9e896 PN |
197 | print "ok 32\n"; |
198 | ||
d7d589a8 | 199 | print "not " unless "\N{BOM}" eq chr(0xFEFF); |
51e9e896 PN |
200 | print "ok 33\n"; |
201 | ||
52ea3e69 JH |
202 | { |
203 | use warnings 'deprecated'; | |
204 | ||
205 | print "not " unless "\N{HORIZONTAL TABULATION}" eq "\t"; | |
51e9e896 | 206 | print "ok 34\n"; |
52ea3e69 JH |
207 | |
208 | print "not " unless grep { /"HORIZONTAL TABULATION" is deprecated/ } @WARN; | |
51e9e896 | 209 | print "ok 35\n"; |
822ebcc8 | 210 | |
52ea3e69 JH |
211 | no warnings 'deprecated'; |
212 | ||
213 | print "not " unless "\N{VERTICAL TABULATION}" eq "\013"; | |
51e9e896 | 214 | print "ok 36\n"; |
52ea3e69 JH |
215 | |
216 | print "not " if grep { /"VERTICAL TABULATION" is deprecated/ } @WARN; | |
51e9e896 | 217 | print "ok 37\n"; |
52ea3e69 | 218 | } |
822ebcc8 | 219 | |
274085e3 | 220 | print "not " unless charnames::viacode(0xFEFF) eq "ZERO WIDTH NO-BREAK SPACE"; |
a23c04e4 JH |
221 | print "ok 38\n"; |
222 | ||
872c91ae JH |
223 | { |
224 | use warnings; | |
225 | print "not " unless ord("\N{BOM}") == 0xFEFF; | |
226 | print "ok 39\n"; | |
227 | } | |
228 |