Commit | Line | Data |
c8e3bb4c |
1 | # tr.t |
2 | |
f05dd7cc |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
f05dd7cc |
6 | } |
a5095b95 |
7 | |
cbe7f703 |
8 | print "1..29\n"; |
c8e3bb4c |
9 | |
10 | $_ = "abcdefghijklmnopqrstuvwxyz"; |
11 | |
12 | tr/a-z/A-Z/; |
13 | |
14 | print "not " unless $_ eq "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; |
15 | print "ok 1\n"; |
16 | |
17 | tr/A-Z/a-z/; |
18 | |
19 | print "not " unless $_ eq "abcdefghijklmnopqrstuvwxyz"; |
20 | print "ok 2\n"; |
21 | |
22 | tr/b-y/B-Y/; |
23 | |
24 | print "not " unless $_ eq "aBCDEFGHIJKLMNOPQRSTUVWXYz"; |
25 | print "ok 3\n"; |
26 | |
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). |
5e037136 |
30 | { |
31 | no utf8; |
32 | $_ = "I\xcaJ"; |
c8e3bb4c |
33 | |
5e037136 |
34 | tr/I-J/i-j/; |
c8e3bb4c |
35 | |
5e037136 |
36 | print "not " unless $_ eq "i\xcaj"; |
37 | print "ok 4\n"; |
38 | } |
c8e3bb4c |
39 | # |
2de7b02f |
40 | |
41 | # make sure that tr cancels IOK and NOK |
42 | ($x = 12) =~ tr/1/3/; |
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; |
47 | print "ok 5\n"; |
48 | |
49 | # make sure tr is harmless if not updating - see [ID 20000511.005] |
50 | $_ = 'fred'; |
51 | /([a-z]{2})/; |
52 | $1 =~ tr/A-Z//; |
53 | s/^(\s*)f/$1F/; |
54 | print "not " if $_ ne 'Fred'; |
55 | print "ok 6\n"; |
56 | |
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; |
60 | print "ok 7\n"; |
61 | $x =~ tr/A/B/; |
67a17885 |
62 | if (ord("\t") == 9) { # ASCII |
63 | print "not " if $x ne 256.66.258 or length $x != 3; |
64 | } |
65 | else { |
66 | print "not " if $x ne 256.65.258 or length $x != 3; |
67 | } |
2de7b02f |
68 | print "ok 8\n"; |
cbe7f703 |
69 | # EBCDIC variants of the above tests |
70 | ($x = 256.193.258) =~ tr/a/b/; |
71 | print "not " if $x ne 256.193.258 or length $x != 3; |
72 | print "ok 9\n"; |
73 | $x =~ tr/A/B/; |
74 | if (ord("\t") == 9) { # ASCII |
75 | print "not " if $x ne 256.193.258 or length $x != 3; |
76 | } |
77 | else { |
78 | print "not " if $x ne 256.194.258 or length $x != 3; |
79 | } |
80 | print "ok 10\n"; |
036b4402 |
81 | |
82 | { |
67a17885 |
83 | if (ord("\t") == 9) { # ASCII |
84 | use utf8; |
85 | } |
cbe7f703 |
86 | # 11 - changing UTF8 characters in a UTF8 string, same length. |
036b4402 |
87 | $l = chr(300); $r = chr(400); |
88 | $x = 200.300.400; |
89 | $x =~ tr/\x{12c}/\x{190}/; |
90 | printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3; |
cbe7f703 |
91 | print "ok 11\n"; |
036b4402 |
92 | |
cbe7f703 |
93 | # 12 - changing UTF8 characters in UTF8 string, more bytes. |
036b4402 |
94 | $x = 200.300.400; |
95 | $x =~ tr/\x{12c}/\x{be8}/; |
96 | printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3; |
cbe7f703 |
97 | print "ok 12\n"; |
036b4402 |
98 | |
cbe7f703 |
99 | # 13 - introducing UTF8 characters to non-UTF8 string. |
036b4402 |
100 | $x = 100.125.60; |
101 | $x =~ tr/\x{64}/\x{190}/; |
102 | printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3; |
cbe7f703 |
103 | print "ok 13\n"; |
036b4402 |
104 | |
cbe7f703 |
105 | # 14 - removing UTF8 characters from UTF8 string |
036b4402 |
106 | $x = 400.125.60; |
107 | $x =~ tr/\x{190}/\x{64}/; |
108 | printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3; |
cbe7f703 |
109 | print "ok 14\n"; |
036b4402 |
110 | |
cbe7f703 |
111 | # 15 - counting UTF8 chars in UTF8 string |
036b4402 |
112 | $x = 400.125.60.400; |
113 | $y = $x =~ tr/\x{190}/\x{190}/; |
114 | print "not " if $y != 2; |
cbe7f703 |
115 | print "ok 15\n"; |
036b4402 |
116 | |
cbe7f703 |
117 | # 16 - counting non-UTF8 chars in UTF8 string |
036b4402 |
118 | $x = 60.400.125.60.400; |
119 | $y = $x =~ tr/\x{3c}/\x{3c}/; |
120 | print "not " if $y != 2; |
cbe7f703 |
121 | print "ok 16\n"; |
036b4402 |
122 | |
cbe7f703 |
123 | # 17 - counting UTF8 chars in non-UTF8 string |
036b4402 |
124 | $x = 200.125.60; |
125 | $y = $x =~ tr/\x{190}/\x{190}/; |
126 | print "not " if $y != 0; |
cbe7f703 |
127 | print "ok 17\n"; |
036b4402 |
128 | } |
c2e66d9e |
129 | |
cbe7f703 |
130 | # 18: test brokenness with tr/a-z-9//; |
c2e66d9e |
131 | $_ = "abcdefghijklmnopqrstuvwxyz"; |
132 | eval "tr/a-z-9/ /"; |
133 | print (($@ =~ /^Ambiguous range in transliteration operator/) |
cbe7f703 |
134 | ? '' : 'not ', "ok 18\n"); |
c2e66d9e |
135 | |
cbe7f703 |
136 | # 19-21: Make sure leading and trailing hyphens still work |
c2e66d9e |
137 | $_ = "car-rot9"; |
138 | tr/-a-m/./; |
cbe7f703 |
139 | print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n"); |
c2e66d9e |
140 | |
141 | $_ = "car-rot9"; |
142 | tr/a-m-/./; |
cbe7f703 |
143 | print (($_ eq '..r.rot9') ? '' : 'not ', "ok 20\n"); |
c2e66d9e |
144 | |
145 | $_ = "car-rot9"; |
146 | tr/-a-m-/./; |
cbe7f703 |
147 | print (($_ eq '..r.rot9') ? '' : 'not ', "ok 21\n"); |
c2e66d9e |
148 | |
149 | $_ = "abcdefghijklmnop"; |
150 | tr/ae-hn/./; |
cbe7f703 |
151 | print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 22\n"); |
c2e66d9e |
152 | |
153 | $_ = "abcdefghijklmnop"; |
154 | tr/a-cf-kn-p/./; |
cbe7f703 |
155 | print (($_ eq '...de......lm...') ? '' : 'not ', "ok 23\n"); |
c2e66d9e |
156 | |
157 | $_ = "abcdefghijklmnop"; |
158 | tr/a-ceg-ikm-o/./; |
cbe7f703 |
159 | print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 24\n"); |
c2e66d9e |
160 | |
cbe7f703 |
161 | # 25: Test reversed range check |
c2e66d9e |
162 | # 20000705 MJD |
163 | eval "tr/m-d/ /"; |
164 | print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/) |
cbe7f703 |
165 | ? '' : 'not ', "ok 25\n"); |
c2e66d9e |
166 | |
cbe7f703 |
167 | # 26: test cannot update if read-only |
d897a58d |
168 | eval '$1 =~ tr/x/y/'; |
169 | print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ', |
cbe7f703 |
170 | "ok 26\n"); |
d897a58d |
171 | |
cbe7f703 |
172 | # 27: test can count read-only |
d897a58d |
173 | 'abcdef' =~ /(bcd)/; |
cbe7f703 |
174 | print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 27\n"); |
d897a58d |
175 | |
cbe7f703 |
176 | # 28: test lhs OK if not updating |
177 | print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 28\n"); |
d897a58d |
178 | |
cbe7f703 |
179 | # 29: test lhs bad if updating |
d897a58d |
180 | eval '"123" =~ tr/1/1/'; |
181 | print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|) |
cbe7f703 |
182 | ? '' : 'not ', "ok 29\n"); |
d897a58d |
183 | |