t/op/tr.t

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