Commit | Line | Data |
c8e3bb4c |
1 | # tr.t |
2 | |
f05dd7cc |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | unshift @INC, "../lib"; |
6 | } |
a5095b95 |
7 | |
d897a58d |
8 | print "1..27\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/; |
62 | print "not " if $x ne 256.66.258 or length $x != 3; |
63 | print "ok 8\n"; |
036b4402 |
64 | |
65 | { |
66 | use utf8; |
67 | |
68 | # 9 - changing UTF8 characters in a UTF8 string, same length. |
69 | $l = chr(300); $r = chr(400); |
70 | $x = 200.300.400; |
71 | $x =~ tr/\x{12c}/\x{190}/; |
72 | printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3; |
73 | print "ok 9\n"; |
74 | |
75 | # 10 - changing UTF8 characters in UTF8 string, more bytes. |
76 | $x = 200.300.400; |
77 | $x =~ tr/\x{12c}/\x{be8}/; |
78 | printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3; |
79 | print "ok 10\n"; |
80 | |
81 | # 11 - introducing UTF8 characters to non-UTF8 string. |
82 | $x = 100.125.60; |
83 | $x =~ tr/\x{64}/\x{190}/; |
84 | printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3; |
85 | print "ok 11\n"; |
86 | |
87 | # 12 - removing UTF8 characters from UTF8 string |
88 | $x = 400.125.60; |
89 | $x =~ tr/\x{190}/\x{64}/; |
90 | printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3; |
91 | print "ok 12\n"; |
92 | |
93 | # 13 - counting UTF8 chars in UTF8 string |
94 | $x = 400.125.60.400; |
95 | $y = $x =~ tr/\x{190}/\x{190}/; |
96 | print "not " if $y != 2; |
97 | print "ok 13\n"; |
98 | |
99 | # 14 - counting non-UTF8 chars in UTF8 string |
100 | $x = 60.400.125.60.400; |
101 | $y = $x =~ tr/\x{3c}/\x{3c}/; |
102 | print "not " if $y != 2; |
103 | print "ok 14\n"; |
104 | |
105 | # 15 - counting UTF8 chars in non-UTF8 string |
106 | $x = 200.125.60; |
107 | $y = $x =~ tr/\x{190}/\x{190}/; |
108 | print "not " if $y != 0; |
109 | print "ok 15\n"; |
110 | } |
c2e66d9e |
111 | |
112 | # 16: test brokenness with tr/a-z-9//; |
113 | $_ = "abcdefghijklmnopqrstuvwxyz"; |
114 | eval "tr/a-z-9/ /"; |
115 | print (($@ =~ /^Ambiguous range in transliteration operator/) |
116 | ? '' : 'not ', "ok 16\n"); |
117 | |
118 | # 17-19: Make sure leading and trailing hyphens still work |
119 | $_ = "car-rot9"; |
120 | tr/-a-m/./; |
121 | print (($_ eq '..r.rot9') ? '' : 'not ', "ok 17\n"); |
122 | |
123 | $_ = "car-rot9"; |
124 | tr/a-m-/./; |
125 | print (($_ eq '..r.rot9') ? '' : 'not ', "ok 18\n"); |
126 | |
127 | $_ = "car-rot9"; |
128 | tr/-a-m-/./; |
129 | print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n"); |
130 | |
131 | $_ = "abcdefghijklmnop"; |
132 | tr/ae-hn/./; |
133 | print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 20\n"); |
134 | |
135 | $_ = "abcdefghijklmnop"; |
136 | tr/a-cf-kn-p/./; |
137 | print (($_ eq '...de......lm...') ? '' : 'not ', "ok 21\n"); |
138 | |
139 | $_ = "abcdefghijklmnop"; |
140 | tr/a-ceg-ikm-o/./; |
141 | print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 22\n"); |
142 | |
143 | # 23: Test reversed range check |
144 | # 20000705 MJD |
145 | eval "tr/m-d/ /"; |
146 | print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/) |
147 | ? '' : 'not ', "ok 23\n"); |
148 | |
d897a58d |
149 | # 24: test cannot update if read-only |
150 | eval '$1 =~ tr/x/y/'; |
151 | print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ', |
152 | "ok 24\n"); |
153 | |
154 | # 25: test can count read-only |
155 | 'abcdef' =~ /(bcd)/; |
156 | print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 25\n"); |
157 | |
158 | # 26: test lhs OK if not updating |
159 | print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 26\n"); |
160 | |
161 | # 27: test lhs bad if updating |
162 | eval '"123" =~ tr/1/1/'; |
163 | print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|) |
164 | ? '' : 'not ', "ok 27\n"); |
165 | |