Commit | Line | Data |
f96ec2a2 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
f96ec2a2 |
6 | $ENV{PERL5LIB} = '../lib'; |
f70c35af |
7 | if ( ord("\t") != 9 ) { # skip on ebcdic platforms |
8 | print "1..0 # Skip utf8 tests on ebcdic platform.\n"; |
9 | exit; |
10 | } |
f96ec2a2 |
11 | } |
12 | |
31067593 |
13 | print "1..72\n"; |
f96ec2a2 |
14 | |
15 | my $test = 1; |
16 | |
17 | sub ok { |
18 | my ($got,$expect) = @_; |
19 | print "# expected [$expect], got [$got]\nnot " if $got ne $expect; |
20 | print "ok $test\n"; |
21 | } |
22 | |
7bbb0251 |
23 | sub nok { |
24 | my ($got,$expect) = @_; |
25 | print "# expected not [$expect], got [$got]\nnot " if $got eq $expect; |
26 | print "ok $test\n"; |
27 | } |
28 | |
be341bce |
29 | sub ok_bytes { |
30 | use bytes; |
31 | my ($got,$expect) = @_; |
32 | print "# expected [$expect], got [$got]\nnot " if $got ne $expect; |
33 | print "ok $test\n"; |
34 | } |
35 | |
7bbb0251 |
36 | sub nok_bytes { |
37 | use bytes; |
38 | my ($got,$expect) = @_; |
39 | print "# expected not [$expect], got [$got]\nnot " if $got eq $expect; |
40 | print "ok $test\n"; |
41 | } |
be341bce |
42 | |
f96ec2a2 |
43 | { |
44 | use utf8; |
45 | $_ = ">\x{263A}<"; |
46 | s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg; |
47 | ok $_, '>☺<'; |
c5cc3500 |
48 | $test++; # 1 |
f96ec2a2 |
49 | |
50 | $_ = ">\x{263A}<"; |
51 | my $rx = "\x{80}-\x{10ffff}"; |
52 | s/([$rx])/"&#".ord($1).";"/eg; |
53 | ok $_, '>☺<'; |
c5cc3500 |
54 | $test++; # 2 |
f96ec2a2 |
55 | |
56 | $_ = ">\x{263A}<"; |
57 | my $rx = "\\x{80}-\\x{10ffff}"; |
58 | s/([$rx])/"&#".ord($1).";"/eg; |
59 | ok $_, '>☺<'; |
c5cc3500 |
60 | $test++; # 3 |
b8c5462f |
61 | |
62 | $_ = "alpha,numeric"; |
63 | m/([[:alpha:]]+)/; |
64 | ok $1, 'alpha'; |
c5cc3500 |
65 | $test++; # 4 |
b8c5462f |
66 | |
67 | $_ = "alphaNUMERICstring"; |
68 | m/([[:^lower:]]+)/; |
69 | ok $1, 'NUMERIC'; |
c5cc3500 |
70 | $test++; # 5 |
b8c5462f |
71 | |
72 | $_ = "alphaNUMERICstring"; |
73 | m/(\p{Ll}+)/; |
74 | ok $1, 'alpha'; |
c5cc3500 |
75 | $test++; # 6 |
b8c5462f |
76 | |
77 | $_ = "alphaNUMERICstring"; |
78 | m/(\p{Lu}+)/; |
79 | ok $1, 'NUMERIC'; |
c5cc3500 |
80 | $test++; # 7 |
b8c5462f |
81 | |
82 | $_ = "alpha,numeric"; |
83 | m/([\p{IsAlpha}]+)/; |
84 | ok $1, 'alpha'; |
c5cc3500 |
85 | $test++; # 8 |
b8c5462f |
86 | |
87 | $_ = "alphaNUMERICstring"; |
88 | m/([^\p{IsLower}]+)/; |
89 | ok $1, 'NUMERIC'; |
c5cc3500 |
90 | $test++; # 9 |
b8c5462f |
91 | |
0f4b6630 |
92 | $_ = "alpha123numeric456"; |
93 | m/([\p{IsDigit}]+)/; |
94 | ok $1, '123'; |
c5cc3500 |
95 | $test++; # 10 |
b8c5462f |
96 | |
0f4b6630 |
97 | $_ = "alpha123numeric456"; |
98 | m/([^\p{IsDigit}]+)/; |
99 | ok $1, 'alpha'; |
c5cc3500 |
100 | $test++; # 11 |
b8c5462f |
101 | |
0f4b6630 |
102 | $_ = ",123alpha,456numeric"; |
103 | m/([\p{IsAlnum}]+)/; |
104 | ok $1, '123alpha'; |
c5cc3500 |
105 | $test++; # 12 |
0f4b6630 |
106 | } |
a197cbdd |
107 | { |
108 | use utf8; |
109 | |
110 | $_ = "\x{263A}>\x{263A}\x{263A}"; |
111 | |
112 | ok length, 4; |
c5cc3500 |
113 | $test++; # 13 |
a197cbdd |
114 | |
115 | ok length((m/>(.)/)[0]), 1; |
c5cc3500 |
116 | $test++; # 14 |
a197cbdd |
117 | |
118 | ok length($&), 2; |
c5cc3500 |
119 | $test++; # 15 |
a197cbdd |
120 | |
121 | ok length($'), 1; |
c5cc3500 |
122 | $test++; # 16 |
a197cbdd |
123 | |
124 | ok length($`), 1; |
c5cc3500 |
125 | $test++; # 17 |
a197cbdd |
126 | |
127 | ok length($1), 1; |
c5cc3500 |
128 | $test++; # 18 |
a197cbdd |
129 | |
130 | ok length($tmp=$&), 2; |
c5cc3500 |
131 | $test++; # 19 |
a197cbdd |
132 | |
133 | ok length($tmp=$'), 1; |
c5cc3500 |
134 | $test++; # 20 |
a197cbdd |
135 | |
136 | ok length($tmp=$`), 1; |
c5cc3500 |
137 | $test++; # 21 |
a197cbdd |
138 | |
139 | ok length($tmp=$1), 1; |
c5cc3500 |
140 | $test++; # 22 |
a197cbdd |
141 | |
c5cc3500 |
142 | { |
be341bce |
143 | use bytes; |
c5cc3500 |
144 | |
be341bce |
145 | my $tmp = $&; |
c5cc3500 |
146 | ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272); |
147 | $test++; # 23 |
a197cbdd |
148 | |
c5cc3500 |
149 | $tmp = $'; |
150 | ok $tmp, pack("C*", 0342, 0230, 0272); |
151 | $test++; # 24 |
a197cbdd |
152 | |
c5cc3500 |
153 | $tmp = $`; |
154 | ok $tmp, pack("C*", 0342, 0230, 0272); |
155 | $test++; # 25 |
a197cbdd |
156 | |
c5cc3500 |
157 | $tmp = $1; |
158 | ok $tmp, pack("C*", 0342, 0230, 0272); |
159 | $test++; # 26 |
160 | } |
a197cbdd |
161 | |
be341bce |
162 | ok_bytes $&, pack("C*", ord(">"), 0342, 0230, 0272); |
163 | $test++; # 27 |
164 | |
165 | ok_bytes $', pack("C*", 0342, 0230, 0272); |
166 | $test++; # 28 |
167 | |
168 | ok_bytes $`, pack("C*", 0342, 0230, 0272); |
169 | $test++; # 29 |
170 | |
171 | ok_bytes $1, pack("C*", 0342, 0230, 0272); |
172 | $test++; # 30 |
173 | |
a197cbdd |
174 | { |
175 | use bytes; |
176 | no utf8; |
177 | |
178 | ok length, 10; |
be341bce |
179 | $test++; # 31 |
a197cbdd |
180 | |
181 | ok length((m/>(.)/)[0]), 1; |
be341bce |
182 | $test++; # 32 |
a197cbdd |
183 | |
184 | ok length($&), 2; |
be341bce |
185 | $test++; # 33 |
a197cbdd |
186 | |
187 | ok length($'), 5; |
be341bce |
188 | $test++; # 34 |
a197cbdd |
189 | |
190 | ok length($`), 3; |
be341bce |
191 | $test++; # 35 |
a197cbdd |
192 | |
193 | ok length($1), 1; |
be341bce |
194 | $test++; # 36 |
a197cbdd |
195 | |
196 | ok $&, pack("C*", ord(">"), 0342); |
be341bce |
197 | $test++; # 37 |
a197cbdd |
198 | |
199 | ok $', pack("C*", 0230, 0272, 0342, 0230, 0272); |
be341bce |
200 | $test++; # 38 |
a197cbdd |
201 | |
202 | ok $`, pack("C*", 0342, 0230, 0272); |
be341bce |
203 | $test++; # 39 |
a197cbdd |
204 | |
205 | ok $1, pack("C*", 0342); |
be341bce |
206 | $test++; # 40 |
a197cbdd |
207 | |
208 | } |
209 | |
210 | |
211 | { |
212 | no utf8; |
213 | $_="\342\230\272>\342\230\272\342\230\272"; |
214 | } |
215 | |
216 | ok length, 10; |
be341bce |
217 | $test++; # 41 |
a197cbdd |
218 | |
219 | ok length((m/>(.)/)[0]), 1; |
be341bce |
220 | $test++; # 42 |
a197cbdd |
221 | |
222 | ok length($&), 2; |
be341bce |
223 | $test++; # 43 |
a197cbdd |
224 | |
225 | ok length($'), 1; |
be341bce |
226 | $test++; # 44 |
a197cbdd |
227 | |
228 | ok length($`), 1; |
be341bce |
229 | $test++; # 45 |
a197cbdd |
230 | |
231 | ok length($1), 1; |
be341bce |
232 | $test++; # 46 |
a197cbdd |
233 | |
234 | ok length($tmp=$&), 2; |
be341bce |
235 | $test++; # 47 |
a197cbdd |
236 | |
237 | ok length($tmp=$'), 1; |
be341bce |
238 | $test++; # 48 |
a197cbdd |
239 | |
240 | ok length($tmp=$`), 1; |
be341bce |
241 | $test++; # 49 |
a197cbdd |
242 | |
243 | ok length($tmp=$1), 1; |
be341bce |
244 | $test++; # 50 |
a197cbdd |
245 | |
c5cc3500 |
246 | { |
247 | use bytes; |
a197cbdd |
248 | |
c5cc3500 |
249 | my $tmp = $&; |
250 | ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272); |
be341bce |
251 | $test++; # 51 |
a197cbdd |
252 | |
c5cc3500 |
253 | $tmp = $'; |
254 | ok $tmp, pack("C*", 0342, 0230, 0272); |
be341bce |
255 | $test++; # 52 |
a197cbdd |
256 | |
c5cc3500 |
257 | $tmp = $`; |
258 | ok $tmp, pack("C*", 0342, 0230, 0272); |
be341bce |
259 | $test++; # 53 |
a197cbdd |
260 | |
c5cc3500 |
261 | $tmp = $1; |
262 | ok $tmp, pack("C*", 0342, 0230, 0272); |
be341bce |
263 | $test++; # 54 |
c5cc3500 |
264 | } |
a197cbdd |
265 | { |
266 | use bytes; |
267 | no utf8; |
268 | |
269 | ok length, 10; |
be341bce |
270 | $test++; # 55 |
a197cbdd |
271 | |
272 | ok length((m/>(.)/)[0]), 1; |
be341bce |
273 | $test++; # 56 |
a197cbdd |
274 | |
275 | ok length($&), 2; |
be341bce |
276 | $test++; # 57 |
a197cbdd |
277 | |
278 | ok length($'), 5; |
be341bce |
279 | $test++; # 58 |
a197cbdd |
280 | |
281 | ok length($`), 3; |
be341bce |
282 | $test++; # 59 |
a197cbdd |
283 | |
284 | ok length($1), 1; |
be341bce |
285 | $test++; # 60 |
a197cbdd |
286 | |
287 | ok $&, pack("C*", ord(">"), 0342); |
be341bce |
288 | $test++; # 61 |
a197cbdd |
289 | |
290 | ok $', pack("C*", 0230, 0272, 0342, 0230, 0272); |
be341bce |
291 | $test++; # 62 |
a197cbdd |
292 | |
293 | ok $`, pack("C*", 0342, 0230, 0272); |
be341bce |
294 | $test++; # 63 |
a197cbdd |
295 | |
296 | ok $1, pack("C*", 0342); |
be341bce |
297 | $test++; # 64 |
a197cbdd |
298 | |
299 | } |
de35ba6f |
300 | |
301 | ok "\x{ab}" =~ /^\x{ab}$/, 1; |
be341bce |
302 | $test++; # 65 |
a197cbdd |
303 | } |
aaa68c4a |
304 | |
305 | { |
306 | use utf8; |
307 | ok_bytes chr(0xe2), pack("C*", 0xc3, 0xa2); |
308 | $test++; # 66 |
309 | } |
28cb3359 |
310 | |
311 | { |
312 | use utf8; |
313 | my @a = map ord, split(//, join("", map chr, (1234, 123, 2345))); |
314 | ok "@a", "1234 123 2345"; |
315 | $test++; # 67 |
316 | } |
317 | |
318 | { |
319 | use utf8; |
320 | my $x = chr(123); |
321 | my @a = map ord, split(/$x/, join("", map chr, (1234, 123, 2345))); |
322 | ok "@a", "1234 2345"; |
323 | $test++; # 68 |
324 | } |
31067593 |
325 | |
7bbb0251 |
326 | { |
327 | my($a,$b); |
328 | { use bytes; $a = "\xc3\xa4"; } |
329 | { use utf8; $b = "\xe4"; } |
330 | { use bytes; ok_bytes $a, $b; $test++; } # 69 |
331 | { use utf8; nok $a, $b; $test++; } # 70 |
332 | } |
31067593 |
333 | |
334 | { |
335 | my @x = ("stra\337e 138","stra\337e 138"); |
336 | for (@x) { |
337 | s/(\d+)\s*([\w\-]+)/$1 . uc $2/e; |
338 | my($latin) = /^(.+)(?:\s+\d)/; |
339 | print $latin eq "stra\337e" ? "ok $test\n" : |
340 | "#latin[$latin]\nnot ok $test\n"; |
341 | $test++; |
342 | $latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a |
343 | use utf8; |
344 | $latin =~ s!(s)tr(?:aß|s+e)!$1tr.!; # \303\237 after the a |
345 | } |
346 | } |