This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/op/tr.t: add tr///c tests
[perl5.git] / t / op / tr.t
CommitLineData
c8e3bb4c 1# tr.t
f4240379 2$|=1;
c8e3bb4c 3
f05dd7cc
JH
4BEGIN {
5 chdir 't' if -d 't';
953ab6e5 6 require './test.pl';
43ece5b1 7 set_up_inc('../lib');
47918419
JH
8 if (is_miniperl()) {
9 eval 'require utf8';
caab73c0 10 if ($@) { skip_all("miniperl, no 'utf8'") }
47918419 11 }
f05dd7cc 12}
a5095b95 13
47918419
JH
14use utf8;
15
33252809 16plan tests => 296;
953ab6e5 17
f605e527
FC
18# Test this first before we extend the stack with other operations.
19# This caused an asan failure due to a bad write past the end of the stack.
20eval { my $x; die 1..127, $x =~ y/// };
21
c8e3bb4c
GS
22$_ = "abcdefghijklmnopqrstuvwxyz";
23
24tr/a-z/A-Z/;
25
953ab6e5 26is($_, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 'uc');
c8e3bb4c
GS
27
28tr/A-Z/a-z/;
29
953ab6e5 30is($_, "abcdefghijklmnopqrstuvwxyz", 'lc');
c8e3bb4c
GS
31
32tr/b-y/B-Y/;
953ab6e5 33is($_, "aBCDEFGHIJKLMNOPQRSTUVWXYz", 'partial uc');
c8e3bb4c 34
8efef67c
KW
35tr/a-a/AB/;
36is($_, "ABCDEFGHIJKLMNOPQRSTUVWXYz", 'single char range a-a');
37
f4240379
KW
38eval 'tr/a/\N{KATAKANA LETTER AINU P}/;';
39like $@,
92e8e650 40 qr/\\N\{KATAKANA LETTER AINU P\} must not be a named sequence in transliteration operator/,
f4240379
KW
41 "Illegal to tr/// named sequence";
42
43eval 'tr/\x{101}-\x{100}//;';
44like $@,
92e8e650 45 qr/Invalid range "\\x\{0101\}-\\x\{0100\}" in transliteration operator/,
f4240379
KW
46 "UTF-8 range with min > max";
47
33252809
DM
48
49# Test /c and variants, with all the search and replace chars being
50# non-utf8, but with both non-utf8 and utf8 strings.
51
52{
53 my $all255 = join '', map chr, 0..0xff;
54 my $all255_twice = join '', map chr, map { ($_, $_) } 0..0xff;
55 my $all255_plus = join '', map chr, 0..0x11f;
56 my $all255_twice_plus = join '', map chr, map { ($_, $_) } 0..0x11f;
57 my ($c, $s);
58
59
60 # length(replacement) == 0
61 # non-utf8 string
62
63 $s = $all255;
64 $c = $s =~ tr/\x40-\xbf//c;
65 is $s, $all255, "/c ==0";
66 is $c, 0x80, "/c ==0 count";
67
68 $s = $all255;
69 $c = $s =~ tr/\x40-\xbf//cd;
70 is $s, join('', map chr, 0x40..0xbf), "/cd ==0";
71 is $c, 0x80, "/cd ==0 count";
72
73 $s = $all255_twice;
74 $c = $s =~ tr/\x40-\xbf//cs;
75 is $s, join('', map chr,
76 0x00..0x3f,
77 (map { ($_, $_) } 0x40..0xbf),
78 0xc0..0xff,
79 ),
80 "/cs ==0";
81 is $c, 0x100, "/cs ==0 count";
82
83 $s = $all255_twice;
84 $c = $s =~ tr/\x40-\xbf//csd;
85 is $s, join('', map chr, (map { ($_, $_) } 0x40..0xbf)), "/csd ==0";
86 is $c, 0x100, "/csd ==0 count";
87
88
89 # length(search) > length(replacement)
90 # non-utf8 string
91
92 $s = $all255;
93 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/c;
94 is $s, join('', map chr,
95 0x80..0xbf,
96 0x40..0xbf,
97 0x00..0x2f,
98 ((0x2f) x 16),
99 ),
100 "/c >";
101 is $c, 0x80, "/c > count";
102
103 $s = $all255;
104 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/cd;
105 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x2f),
106 "/cd >";
107 is $c, 0x80, "/cd > count";
108
109 $s = $all255_twice;
110 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/cs;
111 is $s, join('', map chr,
112 0x80..0xbf,
113 (map { ($_, $_) } 0x40..0xbf),
114 0x00..0x2f,
115 ),
116 "/cs >";
117 is $c, 0x100, "/cs > count";
118
119 $s = $all255_twice;
120 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/csd;
121 is $s, join('', map chr,
122 0x80..0xbf,
123 (map { ($_, $_) } 0x40..0xbf),
124 0x00..0x2f,
125 ),
126 "/csd >";
127 is $c, 0x100, "/csd > count";
128
129
130 # length(search) == length(replacement)
131 # non-utf8 string
132
133 $s = $all255;
134 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/c;
135 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x3f), "/c ==";
136 is $c, 0x80, "/c == count";
137
138 $s = $all255;
139 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/cd;
140 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x3f), "/cd ==";
141 is $c, 0x80, "/cd == count";
142
143 $s = $all255_twice;
144 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/cs;
145 is $s, join('', map chr,
146 0x80..0xbf,
147 (map { ($_, $_) } 0x40..0xbf),
148 0x00..0x3f,
149 ),
150 "/cs ==";
151 is $c, 0x100, "/cs == count";
152
153 $s = $all255_twice;
154 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/csd;
155 is $s, join('', map chr,
156 0x80..0xbf,
157 (map { ($_, $_) } 0x40..0xbf),
158 0x00..0x3f,
159 ),
160 "/csd ==";
161 is $c, 0x100, "/csd == count";
162
163 # length(search) == length(replacement) - 1
164 # non-utf8 string
165
166
167 $s = $all255;
168 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x30/c;
169 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x2f, 0xf0..0xff),
170 "/c =-";
171 is $c, 0x70, "/c =- count";
172
173 $s = $all255;
174 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x30/cd;
175 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x2f, 0xf0..0xff),
176 "/cd =-";
177 is $c, 0x70, "/cd =- count";
178
179 $s = $all255_twice;
180 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x30/cs;
181 is $s, join('', map chr,
182 0x80..0xbf,
183 (map { ($_, $_) } 0x40..0xbf),
184 0x00..0x2f,
185 (map { ($_, $_) } 0xf0..0xff),
186 ),
187 "/cs =-";
188 is $c, 0xe0, "/cs =- count";
189
190 $s = $all255_twice;
191 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x30/csd;
192 is $s, join('', map chr,
193 0x80..0xbf,
194 (map { ($_, $_) } 0x40..0xbf),
195 0x00..0x2f,
196 (map { ($_, $_) } 0xf0..0xff),
197 ),
198 "/csd =-";
199 is $c, 0xe0, "/csd =- count";
200
201 # length(search) < length(replacement)
202 # non-utf8 string
203
204 $s = $all255;
205 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/c;
206 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x2f, 0xf0..0xff),
207 "/c <";
208 is $c, 0x70, "/c < count";
209
210 $s = $all255;
211 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/cd;
212 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x2f, 0xf0..0xff),
213 "/cd <";
214 is $c, 0x70, "/cd < count";
215
216 $s = $all255_twice;
217 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/cs;
218 is $s, join('', map chr,
219 0x80..0xbf,
220 (map { ($_, $_) } 0x40..0xbf),
221 0x00..0x2f,
222 (map { ($_, $_) } 0xf0..0xff),
223 ),
224 "/cs <";
225 is $c, 0xe0, "/cs < count";
226
227 $s = $all255_twice;
228 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/csd;
229 is $s, join('', map chr,
230 0x80..0xbf,
231 (map { ($_, $_) } 0x40..0xbf),
232 0x00..0x2f,
233 (map { ($_, $_) } 0xf0..0xff),
234 ),
235 "/csd <";
236 is $c, 0xe0, "/csd < count";
237
238
239 # length(replacement) == 0
240 # with some >= 0x100 utf8 chars in the string to be modified
241
242 $s = $all255_plus;
243 $c = $s =~ tr/\x40-\xbf//c;
244 is $s, $all255_plus, "/c ==0U";
245 is $c, 0xa0, "/c ==0U count";
246
247 $s = $all255_plus;
248 $c = $s =~ tr/\x40-\xbf//cd;
249 is $s, join('', map chr, 0x40..0xbf), "/cd ==0U";
250 is $c, 0xa0, "/cd ==0U count";
251
252 $s = $all255_twice_plus;
253 $c = $s =~ tr/\x40-\xbf//cs;
254 is $s, join('', map chr,
255 0x00..0x3f,
256 (map { ($_, $_) } 0x40..0xbf),
257 0xc0..0x11f,
258 ),
259 "/cs ==0U";
260 is $c, 0x140, "/cs ==0U count";
261
262 $s = $all255_twice_plus;
263 $c = $s =~ tr/\x40-\xbf//csd;
264 is $s, join('', map chr, (map { ($_, $_) } 0x40..0xbf)), "/csd ==0U";
265 is $c, 0x140, "/csd ==0U count";
266
267 # length(search) > length(replacement)
268 # with some >= 0x100 utf8 chars in the string to be modified
269
270 $s = $all255_plus;
271 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/c;
272 is $s, join('', map chr,
273 0x80..0xbf,
274 0x40..0xbf,
275 0x00..0x2f,
276 ((0x2f) x 48),
277 ),
278 "/c >U";
279 is $c, 0xa0, "/c >U count";
280
281 $s = $all255_plus;
282 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/cd;
283 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x2f),
284 "/cd >U";
285 is $c, 0xa0, "/cd >U count";
286
287 $s = $all255_twice_plus . "\x3f\x3f\x{200}\x{300}";
288 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/cs;
289 is $s, join('', map chr,
290 0x80..0xbf,
291 (map { ($_, $_) } 0x40..0xbf),
292 0x00..0x2f,
293 0xbf,
294 0x2f,
295 ),
296 "/cs >U";
297 is $c, 0x144, "/cs >U count";
298
299 $s = $all255_twice_plus;
300 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x2f/csd;
301 is $s, join('', map chr,
302 0x80..0xbf,
303 (map { ($_, $_) } 0x40..0xbf),
304 0x00..0x2f,
305 ),
306 "/csd >U";
307 is $c, 0x140, "/csd >U count";
308
309 # length(search) == length(replacement)
310 # with some >= 0x100 utf8 chars in the string to be modified
311
312 $s = $all255_plus;
313 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/c;
314 is $s, join('', map chr,
315 0x80..0xbf,
316 0x40..0xbf,
317 0x00..0x3f,
318 ((0x3f) x 32),
319 ),
320 "/c ==U";
321 is $c, 0xa0, "/c ==U count";
322
323 $s = $all255_plus;
324 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/cd;
325 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x3f), "/cd ==U";
326 is $c, 0xa0, "/cd ==U count";
327
328 $s = $all255_twice_plus . "\x3f\x3f\x{200}\x{300}";
329 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/cs;
330 is $s, join('', map chr,
331 0x80..0xbf,
332 (map { ($_, $_) } 0x40..0xbf),
333 0x00..0x3f,
334 0xbf,
335 0x3f,
336 ),
337 "/cs ==U";
338 is $c, 0x144, "/cs ==U count";
339
340 $s = $all255_twice_plus;
341 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x3f/csd;
342 is $s, join('', map chr,
343 0x80..0xbf,
344 (map { ($_, $_) } 0x40..0xbf),
345 0x00..0x3f,
346 ),
347 "/csd ==U";
348 is $c, 0x140, "/csd ==U count";
349
350
351 # length(search) == length(replacement) - 1
352 # with some >= 0x100 utf8 chars in the string to be modified
353
354 $s = $all255_plus;
355 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x40/c;
356 is $s, join('', map chr,
357 0x80..0xbf,
358 0x40..0xbf,
359 0x00..0x40,
360 ((0x40) x 31),
361 ),
362 "/c =-U";
363 is $c, 0xa0, "/c =-U count";
364
365 $s = $all255_plus;
366 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x40/cd;
367 is $s, join('', map chr, 0x80..0xbf, 0x40..0xbf, 0x00..0x40), "/cd =-U";
368 is $c, 0xa0, "/cd =-U count";
369
370 $s = $all255_twice_plus . "\x3f\x3f\x{200}\x{300}";
371 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x40/cs;
372 is $s, join('', map chr,
373 0x80..0xbf,
374 (map { ($_, $_) } 0x40..0xbf),
375 0x00..0x40,
376 0xbf,
377 0x40,
378 ),
379 "/cs =-U";
380 is $c, 0x144, "/cs =-U count";
381
382 $s = $all255_twice_plus;
383 $c = $s =~ tr/\x40-\xbf/\x80-\xbf\x00-\x40/csd;
384 {
385 local $TODO = "missing last 0x40";
386 is $s, join('', map chr,
387 0x80..0xbf,
388 (map { ($_, $_) } 0x40..0xbf),
389 0x00..0x40,
390 ),
391 "/csd =-U";
392 }
393 is $c, 0x140, "/csd =-U count";
394
395
396
397 # length(search) < length(replacement),
398 # with some >= 0x100 utf8 chars in the string to be modified
399
400 $s = $all255_plus;
401 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/c;
402 is $s, join('', map chr,
403 0x80..0xbf,
404 0x40..0xbf,
405 0x00..0x2f,
406 0xf0..0xff,
407 0x30..0x3f,
408 ((0x3f)x 16),
409 ),
410 "/c <U";
411 is $c, 0x90, "/c <U count";
412
413 $s = $all255_plus;
414 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/cd;
415 {
416 local $TODO = "missing 30-3f";
417 is $s, join('', map chr,
418 0x80..0xbf,
419 0x40..0xbf,
420 0x00..0x2f,
421 0xf0..0xff,
422 0x30..0x3f,
423 ),
424 "/cd <U";
425 }
426 is $c, 0x90, "/cd <U count";
427
428 $s = $all255_twice_plus . "\x3f\x3f\x{200}\x{300}";
429 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/cs;
430 is $s, join('', map chr,
431 0x80..0xbf,
432 (map { ($_, $_) } 0x40..0xbf),
433 0x00..0x2f,
434 (map { ($_, $_) } 0xf0..0xff),
435 0x30..0x3f,
436 0xbf,
437 0x3f,
438 ),
439 "/cs <U";
440 is $c, 0x124, "/cs <U count";
441
442 $s = $all255_twice_plus;
443 $c = $s =~ tr/\x40-\xbf\xf0-\xff/\x80-\xbf\x00-\x3f/csd;
444 {
445 local $TODO = "missing 30-3f";
446 is $s, join('', map chr, 0x80..0xbf,
447 (map { ($_, $_) } 0x40..0xbf),
448 0x00..0x2f,
449 (map { ($_, $_) } 0xf0..0xff),
450 0x30..0x3f,
451 ),
452 "/csd <U";
453 }
454 is $c, 0x120, "/csd <U count";
455}
456
457
f4240379
KW
458SKIP: { # Test literal range end point special handling
459 unless ($::IS_EBCDIC) {
460 skip "Valid only for EBCDIC", 24;
461 }
462
463 $_ = "\x89"; # is 'i'
464 tr/i-j//d;
465 is($_, "", '"\x89" should match [i-j]');
466 $_ = "\x8A";
467 tr/i-j//d;
468 is($_, "\x8A", '"\x8A" shouldnt match [i-j]');
469 $_ = "\x90";
470 tr/i-j//d;
471 is($_, "\x90", '"\x90" shouldnt match [i-j]');
472 $_ = "\x91"; # is 'j'
473 tr/i-j//d;
474 is($_, "", '"\x91" should match [i-j]');
475
476 $_ = "\x89";
477 tr/i-\N{LATIN SMALL LETTER J}//d;
478 is($_, "", '"\x89" should match [i-\N{LATIN SMALL LETTER J}]');
479 $_ = "\x8A";
480 tr/i-\N{LATIN SMALL LETTER J}//d;
481 is($_, "\x8A", '"\x8A" shouldnt match [i-\N{LATIN SMALL LETTER J}]');
482 $_ = "\x90";
483 tr/i-\N{LATIN SMALL LETTER J}//d;
484 is($_, "\x90", '"\x90" shouldnt match [i-\N{LATIN SMALL LETTER J}]');
485 $_ = "\x91";
486 tr/i-\N{LATIN SMALL LETTER J}//d;
487 is($_, "", '"\x91" should match [i-\N{LATIN SMALL LETTER J}]');
488
489 $_ = "\x89";
490 tr/i-\N{U+6A}//d;
491 is($_, "", '"\x89" should match [i-\N{U+6A}]');
492 $_ = "\x8A";
493 tr/i-\N{U+6A}//d;
494 is($_, "\x8A", '"\x8A" shouldnt match [i-\N{U+6A}]');
495 $_ = "\x90";
496 tr/i-\N{U+6A}//d;
497 is($_, "\x90", '"\x90" shouldnt match [i-\N{U+6A}]');
498 $_ = "\x91";
499 tr/i-\N{U+6A}//d;
500 is($_, "", '"\x91" should match [i-\N{U+6A}]');
501
502 $_ = "\x89";
503 tr/\N{U+69}-\N{U+6A}//d;
504 is($_, "", '"\x89" should match [\N{U+69}-\N{U+6A}]');
505 $_ = "\x8A";
506 tr/\N{U+69}-\N{U+6A}//d;
507 is($_, "\x8A", '"\x8A" shouldnt match [\N{U+69}-\N{U+6A}]');
508 $_ = "\x90";
509 tr/\N{U+69}-\N{U+6A}//d;
510 is($_, "\x90", '"\x90" shouldnt match [\N{U+69}-\N{U+6A}]');
511 $_ = "\x91";
512 tr/\N{U+69}-\N{U+6A}//d;
513 is($_, "", '"\x91" should match [\N{U+69}-\N{U+6A}]');
514
515 $_ = "\x89";
516 tr/i-\x{91}//d;
517 is($_, "", '"\x89" should match [i-\x{91}]');
518 $_ = "\x8A";
519 tr/i-\x{91}//d;
520 is($_, "", '"\x8A" should match [i-\x{91}]');
521 $_ = "\x90";
522 tr/i-\x{91}//d;
523 is($_, "", '"\x90" should match [i-\x{91}]');
524 $_ = "\x91";
525 tr/i-\x{91}//d;
526 is($_, "", '"\x91" should match [i-\x{91}]');
527
528 # Need to use eval, because tries to compile on ASCII platforms even
529 # though the tests are skipped, and fails because 0x89-j is an illegal
530 # range there.
531 $_ = "\x89";
532 eval 'tr/\x{89}-j//d';
533 is($_, "", '"\x89" should match [\x{89}-j]');
534 $_ = "\x8A";
535 eval 'tr/\x{89}-j//d';
536 is($_, "", '"\x8A" should match [\x{89}-j]');
537 $_ = "\x90";
538 eval 'tr/\x{89}-j//d';
539 is($_, "", '"\x90" should match [\x{89}-j]');
540 $_ = "\x91";
541 eval 'tr/\x{89}-j//d';
542 is($_, "", '"\x91" should match [\x{89}-j]');
543}
544
c8e3bb4c
GS
545
546# In EBCDIC 'I' is \xc9 and 'J' is \0xd1, 'i' is \x89 and 'j' is \x91.
547# Yes, discontinuities. Regardless, the \xca in the below should stay
548# untouched (and not became \x8a).
5e037136 549{
5e037136 550 $_ = "I\xcaJ";
c8e3bb4c 551
5e037136 552 tr/I-J/i-j/;
c8e3bb4c 553
ff36f15d 554 is($_, "i\xcaj", 'EBCDIC discontinuity');
5e037136 555}
c8e3bb4c 556#
2de7b02f 557
2de7b02f
GS
558($x = 12) =~ tr/1/3/;
559(my $y = 12) =~ tr/1/3/;
560($f = 1.5) =~ tr/1/3/;
561(my $g = 1.5) =~ tr/1/3/;
953ab6e5
MS
562is($x + $y + $f + $g, 71, 'tr cancels IOK and NOK');
563
bb16bae8
FC
564# /r
565$_ = 'adam';
566is y/dam/ve/rd, 'eve', '/r';
567is $_, 'adam', '/r leaves param alone';
568$g = 'ruby';
569is $g =~ y/bury/repl/r, 'perl', '/r with explicit param';
570is $g, 'ruby', '/r leaves explicit param alone';
571is "aaa" =~ y\a\b\r, 'bbb', '/r with constant param';
572ok !eval '$_ !~ y///r', "!~ y///r is forbidden";
573like $@, qr\^Using !~ with tr///r doesn't make sense\,
574 "!~ y///r error message";
575{
576 my $w;
577 my $wc;
578 local $SIG{__WARN__} = sub { $w = shift; ++$wc };
579 local $^W = 1;
580 eval 'y///r; 1';
581 like $w, qr '^Useless use of non-destructive transliteration \(tr///r\)',
582 '/r warns in void context';
583 is $wc, 1, '/r warns just once';
584}
2de7b02f 585
ee95e30c 586# perlbug [ID 20000511.005 (#3237)]
2de7b02f
GS
587$_ = 'fred';
588/([a-z]{2})/;
589$1 =~ tr/A-Z//;
590s/^(\s*)f/$1F/;
953ab6e5
MS
591is($_, 'Fred', 'harmless if explicitly not updating');
592
593
594# A variant of the above, added in 5.7.2
595$_ = 'fred';
596/([a-z]{2})/;
597eval '$1 =~ tr/A-Z/A-Z/;';
598s/^(\s*)f/$1F/;
599is($_, 'Fred', 'harmless if implicitly not updating');
600is($@, '', ' no error');
601
2de7b02f
GS
602
603# check tr handles UTF8 correctly
604($x = 256.65.258) =~ tr/a/b/;
953ab6e5
MS
605is($x, 256.65.258, 'handles UTF8');
606is(length $x, 3);
607
2de7b02f 608$x =~ tr/A/B/;
953ab6e5 609is(length $x, 3);
83bcbc61 610if ($::IS_ASCII) { # ASCII
953ab6e5 611 is($x, 256.66.258);
67a17885
PP
612}
613else {
953ab6e5 614 is($x, 256.65.258);
67a17885 615}
953ab6e5 616
cbe7f703
PP
617# EBCDIC variants of the above tests
618($x = 256.193.258) =~ tr/a/b/;
953ab6e5
MS
619is(length $x, 3);
620is($x, 256.193.258);
621
cbe7f703 622$x =~ tr/A/B/;
953ab6e5 623is(length $x, 3);
83bcbc61 624if ($::IS_ASCII) { # ASCII
953ab6e5 625 is($x, 256.193.258);
cbe7f703
PP
626}
627else {
953ab6e5 628 is($x, 256.194.258);
cbe7f703 629}
953ab6e5 630
036b4402
GS
631
632{
953ab6e5
MS
633 my $l = chr(300); my $r = chr(400);
634 $x = 200.300.400;
635 $x =~ tr/\x{12c}/\x{190}/;
636 is($x, 200.400.400,
637 'changing UTF8 chars in a UTF8 string, same length');
638 is(length $x, 3);
639
640 $x = 200.300.400;
641 $x =~ tr/\x{12c}/\x{be8}/;
642 is($x, 200.3048.400, ' more bytes');
643 is(length $x, 3);
644
645 $x = 100.125.60;
646 $x =~ tr/\x{64}/\x{190}/;
647 is($x, 400.125.60, 'Putting UT8 chars into a non-UTF8 string');
648 is(length $x, 3);
649
650 $x = 400.125.60;
651 $x =~ tr/\x{190}/\x{64}/;
652 is($x, 100.125.60, 'Removing UTF8 chars from UTF8 string');
653 is(length $x, 3);
654
655 $x = 400.125.60.400;
656 $y = $x =~ tr/\x{190}/\x{190}/;
657 is($y, 2, 'Counting UTF8 chars in UTF8 string');
658
659 $x = 60.400.125.60.400;
660 $y = $x =~ tr/\x{3c}/\x{3c}/;
661 is($y, 2, ' non-UTF8 chars in UTF8 string');
662
663 # 17 - counting UTF8 chars in non-UTF8 string
664 $x = 200.125.60;
665 $y = $x =~ tr/\x{190}/\x{190}/;
666 is($y, 0, ' UTF8 chars in non-UTFs string');
036b4402 667}
c2e66d9e 668
c2e66d9e 669$_ = "abcdefghijklmnopqrstuvwxyz";
953ab6e5
MS
670eval 'tr/a-z-9/ /';
671like($@, qr/^Ambiguous range in transliteration operator/, 'tr/a-z-9//');
c2e66d9e 672
cbe7f703 673# 19-21: Make sure leading and trailing hyphens still work
c2e66d9e
GS
674$_ = "car-rot9";
675tr/-a-m/./;
953ab6e5 676is($_, '..r.rot9', 'hyphens, leading');
c2e66d9e
GS
677
678$_ = "car-rot9";
679tr/a-m-/./;
953ab6e5 680is($_, '..r.rot9', ' trailing');
c2e66d9e
GS
681
682$_ = "car-rot9";
683tr/-a-m-/./;
953ab6e5 684is($_, '..r.rot9', ' both');
c2e66d9e
GS
685
686$_ = "abcdefghijklmnop";
687tr/ae-hn/./;
953ab6e5 688is($_, '.bcd....ijklm.op');
c2e66d9e
GS
689
690$_ = "abcdefghijklmnop";
691tr/a-cf-kn-p/./;
953ab6e5 692is($_, '...de......lm...');
c2e66d9e
GS
693
694$_ = "abcdefghijklmnop";
695tr/a-ceg-ikm-o/./;
953ab6e5
MS
696is($_, '...d.f...j.l...p');
697
c2e66d9e 698
c2e66d9e
GS
699# 20000705 MJD
700eval "tr/m-d/ /";
321ecc04 701like($@, qr/^Invalid range "m-d" in transliteration operator/,
953ab6e5 702 'reversed range check');
c2e66d9e 703
d897a58d 704'abcdef' =~ /(bcd)/;
953ab6e5
MS
705is(eval '$1 =~ tr/abcd//', 3, 'explicit read-only count');
706is($@, '', ' no error');
d897a58d 707
953ab6e5
MS
708'abcdef' =~ /(bcd)/;
709is(eval '$1 =~ tr/abcd/abcd/', 3, 'implicit read-only count');
710is($@, '', ' no error');
711
712is(eval '"123" =~ tr/12//', 2, 'LHS of non-updating tr');
d897a58d 713
94bfe852 714eval '"123" =~ tr/1/2/';
953ab6e5
MS
715like($@, qr|^Can't modify constant item in transliteration \(tr///\)|,
716 'LHS bad on updating tr');
717
d897a58d 718
381d18bc
JH
719# v300 (0x12c) is UTF-8-encoded as 196 172 (0xc4 0xac)
720# v400 (0x190) is UTF-8-encoded as 198 144 (0xc6 0x90)
721
722# Transliterate a byte to a byte, all four ways.
723
724($a = v300.196.172.300.196.172) =~ tr/\xc4/\xc5/;
953ab6e5 725is($a, v300.197.172.300.197.172, 'byte2byte transliteration');
381d18bc
JH
726
727($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{c5}/;
953ab6e5 728is($a, v300.197.172.300.197.172);
381d18bc
JH
729
730($a = v300.196.172.300.196.172) =~ tr/\x{c4}/\xc5/;
953ab6e5 731is($a, v300.197.172.300.197.172);
381d18bc
JH
732
733($a = v300.196.172.300.196.172) =~ tr/\x{c4}/\x{c5}/;
953ab6e5 734is($a, v300.197.172.300.197.172);
381d18bc 735
381d18bc
JH
736
737($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{12d}/;
953ab6e5 738is($a, v300.301.172.300.301.172, 'byte2wide transliteration');
381d18bc
JH
739
740($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\xc3/;
953ab6e5 741is($a, v195.196.172.195.196.172, ' wide2byte');
381d18bc
JH
742
743($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\x{12d}/;
953ab6e5 744is($a, v301.196.172.301.196.172, ' wide2wide');
381d18bc 745
381d18bc
JH
746
747($a = v300.196.172.300.196.172) =~ tr/\xc4\x{12c}/\x{12d}\xc3/;
953ab6e5 748is($a, v195.301.172.195.301.172, 'byte2wide & wide2byte');
381d18bc 749
381d18bc
JH
750
751($a = v300.196.172.300.196.172.400.198.144) =~
752 tr/\xac\xc4\x{12c}\x{190}/\xad\x{12d}\xc5\x{191}/;
953ab6e5 753is($a, v197.301.173.197.301.173.401.198.144, 'all together now!');
381d18bc 754
381d18bc 755
953ab6e5
MS
756is((($a = v300.196.172.300.196.172) =~ tr/\xc4/\xc5/), 2,
757 'transliterate and count');
381d18bc 758
953ab6e5 759is((($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\x{12d}/), 2);
381d18bc 760
381d18bc
JH
761
762($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{12d}/c;
953ab6e5 763is($a, v301.196.301.301.196.301, 'translit w/complement');
381d18bc
JH
764
765($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\xc5/c;
953ab6e5 766is($a, v300.197.197.300.197.197);
381d18bc 767
381d18bc
JH
768
769($a = v300.196.172.300.196.172) =~ tr/\xc4//d;
953ab6e5 770is($a, v300.172.300.172, 'translit w/deletion');
381d18bc
JH
771
772($a = v300.196.172.300.196.172) =~ tr/\x{12c}//d;
953ab6e5 773is($a, v196.172.196.172);
381d18bc 774
381d18bc
JH
775
776($a = v196.196.172.300.300.196.172) =~ tr/\xc4/\xc5/s;
953ab6e5 777is($a, v197.172.300.300.197.172, 'translit w/squeeze');
381d18bc
JH
778
779($a = v196.172.300.300.196.172.172) =~ tr/\x{12c}/\x{12d}/s;
953ab6e5 780is($a, v196.172.301.196.172.172);
381d18bc 781
a1874b66 782
953ab6e5 783# Tricky cases (When Simon Cozens Attacks)
a1874b66 784($a = v196.172.200) =~ tr/\x{12c}/a/;
953ab6e5 785is(sprintf("%vd", $a), '196.172.200');
a1874b66
JH
786
787($a = v196.172.200) =~ tr/\x{12c}/\x{12c}/;
953ab6e5 788is(sprintf("%vd", $a), '196.172.200');
a1874b66
JH
789
790($a = v196.172.200) =~ tr/\x{12c}//d;
953ab6e5
MS
791is(sprintf("%vd", $a), '196.172.200');
792
a1874b66 793
8973db79 794# UTF8 range tests from Inaba Hiroto
f9a63242
JH
795
796($a = v300.196.172.302.197.172) =~ tr/\x{12c}-\x{130}/\xc0-\xc4/;
953ab6e5 797is($a, v192.196.172.194.197.172, 'UTF range');
f9a63242
JH
798
799($a = v300.196.172.302.197.172) =~ tr/\xc4-\xc8/\x{12c}-\x{130}/;
953ab6e5
MS
800is($a, v300.300.172.302.301.172);
801
8973db79
JH
802
803# UTF8 range tests from Karsten Sperling (patch #9008 required)
804
805($a = "\x{0100}") =~ tr/\x00-\x{100}/X/;
953ab6e5 806is($a, "X");
8973db79
JH
807
808($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}/X/c;
953ab6e5 809is($a, "X");
8973db79
JH
810
811($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
953ab6e5 812is($a, "X");
8973db79
JH
813
814($a = v256) =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
953ab6e5
MS
815is($a, "X");
816
8973db79 817
94472101
JH
818# UTF8 range tests from Inaba Hiroto
819
820($a = "\x{200}") =~ tr/\x00-\x{100}/X/c;
953ab6e5 821is($a, "X");
94472101
JH
822
823($a = "\x{200}") =~ tr/\x00-\x{100}/X/cs;
953ab6e5
MS
824is($a, "X");
825
685b06b5
KW
826# Tricky on EBCDIC: while [a-z] [A-Z] must not match the gap characters (as
827# well as i-j, r-s, I-J, R-S), [\x89-\x91] [\xc9-\xd1] has to match them,
6b6bd37b
JH
828# from Karsten Sperling.
829
830$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/\x89-\x91/X/;
953ab6e5
MS
831is($c, 8);
832is($a, "XXXXXXXX");
4c3a8340 833
6b6bd37b 834$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/\xc9-\xd1/X/;
953ab6e5
MS
835is($c, 8);
836is($a, "XXXXXXXX");
6b6bd37b 837
4c3a8340 838SKIP: {
f4240379 839 skip "EBCDIC-centric tests", 4 unless $::IS_EBCDIC;
953ab6e5
MS
840
841 $c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j/X/;
842 is($c, 2);
843 is($a, "X\x8a\x8b\x8c\x8d\x8f\x90X");
844
845 $c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J/X/;
846 is($c, 2);
847 is($a, "X\xca\xcb\xcc\xcd\xcf\xd0X");
6b6bd37b 848}
1ed601ec
JH
849
850($a = "\x{100}") =~ tr/\x00-\xff/X/c;
953ab6e5 851is(ord($a), ord("X"));
1ed601ec
JH
852
853($a = "\x{100}") =~ tr/\x00-\xff/X/cs;
953ab6e5 854is(ord($a), ord("X"));
1ed601ec
JH
855
856($a = "\x{100}\x{100}") =~ tr/\x{101}-\x{200}//c;
953ab6e5 857is($a, "\x{100}\x{100}");
1ed601ec
JH
858
859($a = "\x{100}\x{100}") =~ tr/\x{101}-\x{200}//cs;
953ab6e5 860is($a, "\x{100}");
1ed601ec 861
629b4584 862$a = "\xfe\xff"; $a =~ tr/\xfe\xff/\x{1ff}\x{1fe}/;
953ab6e5
MS
863is($a, "\x{1ff}\x{1fe}");
864
76ef7183
JH
865
866# From David Dyck
867($a = "R0_001") =~ tr/R_//d;
953ab6e5 868is(hex($a), 1);
76ef7183 869
800b4dc4
JH
870# From Inaba Hiroto
871@a = (1,2); map { y/1/./ for $_ } @a;
953ab6e5 872is("@a", ". 2");
800b4dc4
JH
873
874@a = (1,2); map { y/1/./ for $_.'' } @a;
953ab6e5
MS
875is("@a", "1 2");
876
800b4dc4 877
bec89253
RH
878# Additional test for Inaba Hiroto patch (robin@kitsite.com)
879($a = "\x{100}\x{102}\x{101}") =~ tr/\x00-\377/XYZ/c;
953ab6e5
MS
880is($a, "XZY");
881
bec89253 882
2233f375
NC
883# Used to fail with "Modification of a read-only value attempted"
884%a = (N=>1);
885foreach (keys %a) {
953ab6e5
MS
886 eval 'tr/N/n/';
887 is($_, 'n', 'pp_trans needs to unshare shared hash keys');
888 is($@, '', ' no error');
2233f375 889}
94bfe852 890
953ab6e5 891
94bfe852 892$x = eval '"1213" =~ tr/1/1/';
953ab6e5
MS
893is($x, 2, 'implicit count on constant');
894is($@, '', ' no error');
895
896
897my @foo = ();
898eval '$foo[-1] =~ tr/N/N/';
899is( $@, '', 'implicit count outside array bounds, index negative' );
900is( scalar @foo, 0, " doesn't extend the array");
901
902eval '$foo[1] =~ tr/N/N/';
903is( $@, '', 'implicit count outside array bounds, index positive' );
904is( scalar @foo, 0, " doesn't extend the array");
905
906
907my %foo = ();
908eval '$foo{bar} =~ tr/N/N/';
909is( $@, '', 'implicit count outside hash bounds' );
910is( scalar keys %foo, 0, " doesn't extend the hash");
d59e14db
RGS
911
912$x = \"foo";
913is( $x =~ tr/A/A/, 2, 'non-modifying tr/// on a scalar ref' );
914is( ref $x, 'SCALAR', " doesn't stringify its argument" );
0d65d7d5
MS
915
916# rt.perl.org 36622. Perl didn't like a y/// at end of file. No trailing
917# newline allowed.
2a91eb11 918fresh_perl_is(q[$_ = "foo"; y/A-Z/a-z/], '', {}, 'RT #36622 y/// at end of file');
9f7f3913
ST
919
920
921{ # [perl #38293] chr(65535) should be allowed in regexes
922no warnings 'utf8'; # to allow non-characters
923
924$s = "\x{d800}\x{ffff}";
925$s =~ tr/\0/A/;
926is($s, "\x{d800}\x{ffff}", "do_trans_simple");
927
928$s = "\x{d800}\x{ffff}";
929$i = $s =~ tr/\0//;
930is($i, 0, "do_trans_count");
931
932$s = "\x{d800}\x{ffff}";
933$s =~ tr/\0/A/s;
934is($s, "\x{d800}\x{ffff}", "do_trans_complex, SQUASH");
935
936$s = "\x{d800}\x{ffff}";
937$s =~ tr/\0/A/c;
938is($s, "AA", "do_trans_complex, COMPLEMENT");
939
940$s = "A\x{ffff}B";
941$s =~ tr/\x{ffff}/\x{1ffff}/;
942is($s, "A\x{1ffff}B", "utf8, SEARCHLIST");
943
944$s = "\x{fffd}\x{fffe}\x{ffff}";
945$s =~ tr/\x{fffd}-\x{ffff}/ABC/;
946is($s, "ABC", "utf8, SEARCHLIST range");
947
948$s = "ABC";
949$s =~ tr/ABC/\x{ffff}/;
950is($s, "\x{ffff}"x3, "utf8, REPLACEMENTLIST");
951
952$s = "ABC";
953$s =~ tr/ABC/\x{fffd}-\x{ffff}/;
954is($s, "\x{fffd}\x{fffe}\x{ffff}", "utf8, REPLACEMENTLIST range");
955
956$s = "A\x{ffff}B\x{100}\0\x{fffe}\x{ffff}";
957$i = $s =~ tr/\x{ffff}//;
958is($i, 2, "utf8, count");
959
960$s = "A\x{ffff}\x{ffff}C";
961$s =~ tr/\x{ffff}/\x{100}/s;
962is($s, "A\x{100}C", "utf8, SQUASH");
963
964$s = "A\x{ffff}\x{ffff}\x{fffe}\x{fffe}\x{fffe}C";
965$s =~ tr/\x{fffe}\x{ffff}//s;
966is($s, "A\x{ffff}\x{fffe}C", "utf8, SQUASH");
967
968$s = "xAABBBy";
969$s =~ tr/AB/\x{ffff}/s;
970is($s, "x\x{ffff}y", "utf8, SQUASH");
971
972$s = "xAABBBy";
973$s =~ tr/AB/\x{fffe}\x{ffff}/s;
974is($s, "x\x{fffe}\x{ffff}y", "utf8, SQUASH");
975
976$s = "A\x{ffff}B\x{fffe}C";
977$s =~ tr/\x{fffe}\x{ffff}/x/c;
978is($s, "x\x{ffff}x\x{fffe}x", "utf8, COMPLEMENT");
979
980$s = "A\x{10000}B\x{2abcd}C";
981$s =~ tr/\0-\x{ffff}/x/c;
982is($s, "AxBxC", "utf8, COMPLEMENT range");
983
984$s = "A\x{fffe}B\x{ffff}C";
985$s =~ tr/\x{fffe}\x{ffff}/x/d;
986is($s, "AxBC", "utf8, DELETE");
987
988} # non-characters end
989
1749ea0d
ST
990{ # related to [perl #27940]
991 my $c;
992
993 ($c = "\x20\c@\x30\cA\x40\cZ\x50\c_\x60") =~ tr/\c@-\c_//d;
994 is($c, "\x20\x30\x40\x50\x60", "tr/\\c\@-\\c_//d");
995
996 ($c = "\x20\x00\x30\x01\x40\x1A\x50\x1F\x60") =~ tr/\x00-\x1f//d;
997 is($c, "\x20\x30\x40\x50\x60", "tr/\\x00-\\x1f//d");
998}
999
3788ef8f 1000($s) = keys %{{pie => 3}};
3e89ba19 1001SKIP: {
e3918bb7
FC
1002 if (!eval { require XS::APItest }) { skip "no XS::APItest", 2 }
1003 my $wasro = XS::APItest::SvIsCOW($s);
2203fb5a 1004 ok $wasro, "have a COW";
3788ef8f 1005 $s =~ tr/i//;
e3918bb7 1006 ok( XS::APItest::SvIsCOW($s),
3e89ba19 1007 "count-only tr doesn't deCOW COWs" );
3788ef8f 1008}
a5446a64
DM
1009
1010# [ RT #61520 ]
1011#
1012# under threads, unicode tr within a cloned closure would SEGV or assert
1013# fail, since the pointer in the pad to the swash was getting zeroed out
1014# in the proto-CV
1015
1016{
1017 my $x = "\x{142}";
1018 sub {
1019 $x =~ tr[\x{142}][\x{143}];
1020 }->();
1021 is($x,"\x{143}", "utf8 + closure");
1022}
1023
9100eeb1
Z
1024# Freeing of trans ops prior to pmtrans() [perl #102858].
1025eval q{ $a ~= tr/a/b/; };
1026ok 1;
1027SKIP: {
55673181 1028 no warnings "deprecated";
9100eeb1
Z
1029 skip "no encoding", 1 unless eval { require encoding; 1 };
1030 eval q{ use encoding "utf8"; $a ~= tr/a/b/; };
1031 ok 1;
1032}
a5446a64 1033
cb6d3474
KW
1034{ # [perl #113584]
1035
1036 my $x = "Perlα";
1037 $x =~ tr/αα/βγ/;
baacc348 1038 { no warnings 'utf8'; print "# $x\n"; } # No note() to avoid wide warning.
cb6d3474
KW
1039 is($x, "Perlβ", "Only first of multiple transliterations is used");
1040}
1041
d8b516a1
FC
1042# tr/a/b/ should fail even on zero-length read-only strings
1043use constant nullrocow => (keys%{{""=>undef}})[0];
1044for ("", nullrocow) {
1045 eval { $_ =~ y/a/b/ };
1046 like $@, qr/^Modification of a read-only value attempted at /,
1047 'tr/a/b/ fails on zero-length ro string';
1048}
1049
a53bfdae
HS
1050# Whether they're permitted or not, non-modifying tr/// should not write
1051# to read-only values, even with funky flags.
1052{ # [perl #123759]
1053 eval q{ ('a' =~ /./) =~ tr///d };
1054 ok(1, "tr///d on PL_Yes does not assert");
1055 eval q{ ('a' =~ /./) =~ tr/a-z/a-z/d };
1056 ok(1, "tr/a-z/a-z/d on PL_Yes does not assert");
1057 eval q{ ('a' =~ /./) =~ tr///s };
1058 ok(1, "tr///s on PL_Yes does not assert");
1059 eval q{ *x =~ tr///d };
1060 ok(1, "tr///d on glob does not assert");
1061}
1062
3a34ca0b 1063{ # [perl #128734
ce4eed6e 1064 my $string = chr utf8::unicode_to_native(0x00e0);
3a34ca0b
KW
1065 $string =~ tr/\N{U+00e0}/A/;
1066 is($string, "A", 'tr// of \N{U+...} works for upper-Latin1');
ce4eed6e 1067 my $string = chr utf8::unicode_to_native(0x00e1);
3a34ca0b
KW
1068 $string =~ tr/\N{LATIN SMALL LETTER A WITH ACUTE}/A/;
1069 is($string, "A", 'tr// of \N{name} works for upper-Latin1');
1070}
1071
2108cbcf
DM
1072# RT #130198
1073# a tr/// that is cho(m)ped, possibly with an array as arg
1074
1075{
1076 use warnings;
1077
1078 my ($s, @a);
1079
1080 my $warn;
1081 local $SIG{__WARN__ } = sub { $warn .= "@_" };
1082
1083 for my $c (qw(chop chomp)) {
1084 for my $bind ('', '$s =~ ', '@a =~ ') {
1085 for my $arg2 (qw(a b)) {
1086 for my $r ('', 'r') {
1087 $warn = '';
1088 # tr/a/b/ modifies its LHS, so if the LHS is an
1089 # array, this should die. The special cases of tr/a/a/
1090 # and tr/a/b/r don't modify their LHS, so instead
1091 # we croak because cho(m)p is trying to modify it.
1092 #
1093 my $exp =
1094 ($r eq '' && $arg2 eq 'b' && $bind =~ /\@a/)
1095 ? qr/Can't modify private array in transliteration/
1096 : qr{Can't modify transliteration \(tr///\) in $c};
1097
1098 my $expr = "$c(${bind}tr/a/$arg2/$r);";
1099 eval $expr;
1100 like $@, $exp, "RT #130198 eval: $expr";
1101
1102 $exp =
1103 $bind =~ /\@a/
1104 ? qr{^Applying transliteration \(tr///\) to \@a will act on scalar\(\@a\)}
1105 : qr/^$/;
1106 like $warn, $exp, "RT #130198 warn: $expr";
1107 }
1108 }
1109 }
1110 }
1111
1112
1113}
1114
fe2ba0a2
KW
1115{ # [perl #130656] This bug happens when the tr is split across lines, so
1116 # that the first line causes it to go into UTF-8, and the 2nd is only
1117 # things like \x
1118 my $x = "\x{E235}";
1119 $x =~ tr
1120 [\x{E234}-\x{E342}\x{E5B5}-\x{E5DF}]
1121 [\x{E5CD}-\x{E5DF}\x{EA80}-\x{EAFA}\x{EB0E}-\x{EB8E}\x{EAFB}-\x{EB0D}\x{E5B5}-\x{E5CC}];
1122
1123 is $x, "\x{E5CE}", '[perl #130656]';
1124}
2108cbcf 1125
9100eeb1 11261;