10 $_ = "abcdefghijklmnopqrstuvwxyz";
14 print "not " unless $_ eq "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
19 print "not " unless $_ eq "abcdefghijklmnopqrstuvwxyz";
24 print "not " unless $_ eq "aBCDEFGHIJKLMNOPQRSTUVWXYz";
27 # In EBCDIC 'I' is \xc9 and 'J' is \0xd1, 'i' is \x89 and 'j' is \x91.
28 # Yes, discontinuities. Regardless, the \xca in the below should stay
29 # untouched (and not became \x8a).
36 print "not " unless $_ eq "i\xcaj";
41 # make sure that tr cancels IOK and NOK
43 (my $y = 12) =~ tr/1/3/;
44 ($f = 1.5) =~ tr/1/3/;
45 (my $g = 1.5) =~ tr/1/3/;
46 print "not " unless $x + $y + $f + $g == 71;
49 # make sure tr is harmless if not updating - see [ID 20000511.005]
54 print "not " if $_ ne 'Fred';
57 # check tr handles UTF8 correctly
58 ($x = 256.65.258) =~ tr/a/b/;
59 print "not " if $x ne 256.65.258 or length $x != 3;
62 if (ord("\t") == 9) { # ASCII
63 print "not " if $x ne 256.66.258 or length $x != 3;
66 print "not " if $x ne 256.65.258 or length $x != 3;
71 if (ord("\t") == 9) { # ASCII
75 # 9 - changing UTF8 characters in a UTF8 string, same length.
76 $l = chr(300); $r = chr(400);
78 $x =~ tr/\x{12c}/\x{190}/;
79 printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3;
82 # 10 - changing UTF8 characters in UTF8 string, more bytes.
84 $x =~ tr/\x{12c}/\x{be8}/;
85 printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3;
88 # 11 - introducing UTF8 characters to non-UTF8 string.
90 $x =~ tr/\x{64}/\x{190}/;
91 printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3;
94 # 12 - removing UTF8 characters from UTF8 string
96 $x =~ tr/\x{190}/\x{64}/;
97 printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3;
100 # 13 - counting UTF8 chars in UTF8 string
102 $y = $x =~ tr/\x{190}/\x{190}/;
103 print "not " if $y != 2;
106 # 14 - counting non-UTF8 chars in UTF8 string
107 $x = 60.400.125.60.400;
108 $y = $x =~ tr/\x{3c}/\x{3c}/;
109 print "not " if $y != 2;
112 # 15 - counting UTF8 chars in non-UTF8 string
114 $y = $x =~ tr/\x{190}/\x{190}/;
115 print "not " if $y != 0;
119 # 16: test brokenness with tr/a-z-9//;
120 $_ = "abcdefghijklmnopqrstuvwxyz";
122 print (($@ =~ /^Ambiguous range in transliteration operator/)
123 ? '' : 'not ', "ok 16\n");
125 # 17-19: Make sure leading and trailing hyphens still work
128 print (($_ eq '..r.rot9') ? '' : 'not ', "ok 17\n");
132 print (($_ eq '..r.rot9') ? '' : 'not ', "ok 18\n");
136 print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n");
138 $_ = "abcdefghijklmnop";
140 print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 20\n");
142 $_ = "abcdefghijklmnop";
144 print (($_ eq '...de......lm...') ? '' : 'not ', "ok 21\n");
146 $_ = "abcdefghijklmnop";
148 print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 22\n");
150 # 23: Test reversed range check
153 print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/)
154 ? '' : 'not ', "ok 23\n");
156 # 24: test cannot update if read-only
157 eval '$1 =~ tr/x/y/';
158 print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ',
161 # 25: test can count read-only
163 print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 25\n");
165 # 26: test lhs OK if not updating
166 print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 26\n");
168 # 27: test lhs bad if updating
169 eval '"123" =~ tr/1/1/';
170 print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|)
171 ? '' : 'not ', "ok 27\n");