This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
One more patch for UTF8
[perl5.git] / t / op / tr.t
CommitLineData
c8e3bb4c
GS
1# tr.t
2
f05dd7cc
JH
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
f05dd7cc 6}
a5095b95 7
cbe7f703 8print "1..29\n";
c8e3bb4c
GS
9
10$_ = "abcdefghijklmnopqrstuvwxyz";
11
12tr/a-z/A-Z/;
13
14print "not " unless $_ eq "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
15print "ok 1\n";
16
17tr/A-Z/a-z/;
18
19print "not " unless $_ eq "abcdefghijklmnopqrstuvwxyz";
20print "ok 2\n";
21
22tr/b-y/B-Y/;
23
24print "not " unless $_ eq "aBCDEFGHIJKLMNOPQRSTUVWXYz";
25print "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
GS
30{
31 no utf8;
32 $_ = "I\xcaJ";
c8e3bb4c 33
5e037136 34 tr/I-J/i-j/;
c8e3bb4c 35
5e037136
GS
36 print "not " unless $_ eq "i\xcaj";
37 print "ok 4\n";
38}
c8e3bb4c 39#
2de7b02f
GS
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/;
46print "not " unless $x + $y + $f + $g == 71;
47print "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//;
53s/^(\s*)f/$1F/;
54print "not " if $_ ne 'Fred';
55print "ok 6\n";
56
57# check tr handles UTF8 correctly
58($x = 256.65.258) =~ tr/a/b/;
59print "not " if $x ne 256.65.258 or length $x != 3;
60print "ok 7\n";
61$x =~ tr/A/B/;
67a17885
PP
62if (ord("\t") == 9) { # ASCII
63 print "not " if $x ne 256.66.258 or length $x != 3;
64}
65else {
66 print "not " if $x ne 256.65.258 or length $x != 3;
67}
2de7b02f 68print "ok 8\n";
cbe7f703
PP
69# EBCDIC variants of the above tests
70($x = 256.193.258) =~ tr/a/b/;
71print "not " if $x ne 256.193.258 or length $x != 3;
72print "ok 9\n";
73$x =~ tr/A/B/;
74if (ord("\t") == 9) { # ASCII
75 print "not " if $x ne 256.193.258 or length $x != 3;
76}
77else {
78 print "not " if $x ne 256.194.258 or length $x != 3;
79}
80print "ok 10\n";
036b4402
GS
81
82{
67a17885
PP
83if (ord("\t") == 9) { # ASCII
84 use utf8;
85}
cbe7f703 86# 11 - changing UTF8 characters in a UTF8 string, same length.
036b4402
GS
87$l = chr(300); $r = chr(400);
88$x = 200.300.400;
89$x =~ tr/\x{12c}/\x{190}/;
90printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3;
cbe7f703 91print "ok 11\n";
036b4402 92
cbe7f703 93# 12 - changing UTF8 characters in UTF8 string, more bytes.
036b4402
GS
94$x = 200.300.400;
95$x =~ tr/\x{12c}/\x{be8}/;
96printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3;
cbe7f703 97print "ok 12\n";
036b4402 98
cbe7f703 99# 13 - introducing UTF8 characters to non-UTF8 string.
036b4402
GS
100$x = 100.125.60;
101$x =~ tr/\x{64}/\x{190}/;
102printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3;
cbe7f703 103print "ok 13\n";
036b4402 104
cbe7f703 105# 14 - removing UTF8 characters from UTF8 string
036b4402
GS
106$x = 400.125.60;
107$x =~ tr/\x{190}/\x{64}/;
108printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3;
cbe7f703 109print "ok 14\n";
036b4402 110
cbe7f703 111# 15 - counting UTF8 chars in UTF8 string
036b4402
GS
112$x = 400.125.60.400;
113$y = $x =~ tr/\x{190}/\x{190}/;
114print "not " if $y != 2;
cbe7f703 115print "ok 15\n";
036b4402 116
cbe7f703 117# 16 - counting non-UTF8 chars in UTF8 string
036b4402
GS
118$x = 60.400.125.60.400;
119$y = $x =~ tr/\x{3c}/\x{3c}/;
120print "not " if $y != 2;
cbe7f703 121print "ok 16\n";
036b4402 122
cbe7f703 123# 17 - counting UTF8 chars in non-UTF8 string
036b4402
GS
124$x = 200.125.60;
125$y = $x =~ tr/\x{190}/\x{190}/;
126print "not " if $y != 0;
cbe7f703 127print "ok 17\n";
036b4402 128}
c2e66d9e 129
cbe7f703 130# 18: test brokenness with tr/a-z-9//;
c2e66d9e
GS
131$_ = "abcdefghijklmnopqrstuvwxyz";
132eval "tr/a-z-9/ /";
133print (($@ =~ /^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
GS
137$_ = "car-rot9";
138tr/-a-m/./;
cbe7f703 139print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n");
c2e66d9e
GS
140
141$_ = "car-rot9";
142tr/a-m-/./;
cbe7f703 143print (($_ eq '..r.rot9') ? '' : 'not ', "ok 20\n");
c2e66d9e
GS
144
145$_ = "car-rot9";
146tr/-a-m-/./;
cbe7f703 147print (($_ eq '..r.rot9') ? '' : 'not ', "ok 21\n");
c2e66d9e
GS
148
149$_ = "abcdefghijklmnop";
150tr/ae-hn/./;
cbe7f703 151print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 22\n");
c2e66d9e
GS
152
153$_ = "abcdefghijklmnop";
154tr/a-cf-kn-p/./;
cbe7f703 155print (($_ eq '...de......lm...') ? '' : 'not ', "ok 23\n");
c2e66d9e
GS
156
157$_ = "abcdefghijklmnop";
158tr/a-ceg-ikm-o/./;
cbe7f703 159print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 24\n");
c2e66d9e 160
cbe7f703 161# 25: Test reversed range check
c2e66d9e
GS
162# 20000705 MJD
163eval "tr/m-d/ /";
164print (($@ =~ /^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
MG
168eval '$1 =~ tr/x/y/';
169print (($@ =~ /^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 174print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 27\n");
d897a58d 175
cbe7f703
PP
176# 28: test lhs OK if not updating
177print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 28\n");
d897a58d 178
cbe7f703 179# 29: test lhs bad if updating
d897a58d
MG
180eval '"123" =~ tr/1/1/';
181print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|)
cbe7f703 182 ? '' : 'not ', "ok 29\n");
d897a58d 183