X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Ftr.t;h=a7b041eda8152c3d885a1bc974814d3f316a54e5;hb=22d4bb9ccb8701e68f9243547d7e3a3c55f70908;hp=ea665c7c8ad3cd5d857d4a66b40959fcd88b7214;hpb=4b19af017623bfa3bb72bb164598a517f586e0d3;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/tr.t b/t/op/tr.t
index ea665c7..a7b041e 100755
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, "../lib";
+    @INC = '../lib';
 }
 
-print "1..27\n";
+print "1..29\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
@@ -59,107 +59,125 @@ print "ok 6\n";
 print "not " if $x ne 256.65.258 or length $x != 3;
 print "ok 7\n";
 $x =~ tr/A/B/;
-print "not " if $x ne 256.66.258 or length $x != 3;
+if (ord("\t") == 9) { # ASCII
+    print "not " if $x ne 256.66.258 or length $x != 3;
+}
+else {
+    print "not " if $x ne 256.65.258 or length $x != 3;
+}
 print "ok 8\n";
+# EBCDIC variants of the above tests
+($x = 256.193.258) =~ tr/a/b/;
+print "not " if $x ne 256.193.258 or length $x != 3;
+print "ok 9\n";
+$x =~ tr/A/B/;
+if (ord("\t") == 9) { # ASCII
+    print "not " if $x ne 256.193.258 or length $x != 3;
+}
+else {
+    print "not " if $x ne 256.194.258 or length $x != 3;
+}
+print "ok 10\n";
 
 {
-use utf8;
-
-# 9 - changing UTF8 characters in a UTF8 string, same length.
+if (ord("\t") == 9) { # ASCII
+    use utf8;
+}
+# 11 - changing UTF8 characters in a UTF8 string, same length.
 $l = chr(300); $r = chr(400);
 $x = 200.300.400;
 $x =~ tr/\x{12c}/\x{190}/;
 printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3;
-print "ok 9\n";
+print "ok 11\n";
 
-# 10 - changing UTF8 characters in UTF8 string, more bytes.
+# 12 - changing UTF8 characters in UTF8 string, more bytes.
 $x = 200.300.400;
 $x =~ tr/\x{12c}/\x{be8}/;
 printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3;
-print "ok 10\n";
+print "ok 12\n";
 
-# 11 - introducing UTF8 characters to non-UTF8 string.
+# 13 - introducing UTF8 characters to non-UTF8 string.
 $x = 100.125.60;
 $x =~ tr/\x{64}/\x{190}/;
 printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3;
-print "ok 11\n";
+print "ok 13\n";
 
-# 12 - removing UTF8 characters from UTF8 string
+# 14 - removing UTF8 characters from UTF8 string
 $x = 400.125.60;
 $x =~ tr/\x{190}/\x{64}/;
 printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3;
-print "ok 12\n";
+print "ok 14\n";
 
-# 13 - counting UTF8 chars in UTF8 string
+# 15 - counting UTF8 chars in UTF8 string
 $x = 400.125.60.400;
 $y = $x =~ tr/\x{190}/\x{190}/;
 print "not " if $y != 2;
-print "ok 13\n";
+print "ok 15\n";
 
-# 14 - counting non-UTF8 chars in UTF8 string
+# 16 - counting non-UTF8 chars in UTF8 string
 $x = 60.400.125.60.400;
 $y = $x =~ tr/\x{3c}/\x{3c}/;
 print "not " if $y != 2;
-print "ok 14\n";
+print "ok 16\n";
 
-# 15 - counting UTF8 chars in non-UTF8 string
+# 17 - counting UTF8 chars in non-UTF8 string
 $x = 200.125.60;
 $y = $x =~ tr/\x{190}/\x{190}/;
 print "not " if $y != 0;
-print "ok 15\n";
+print "ok 17\n";
 }
 
-# 16: test brokenness with tr/a-z-9//;
+# 18: test brokenness with tr/a-z-9//;
 $_ = "abcdefghijklmnopqrstuvwxyz";
 eval "tr/a-z-9/ /";
 print (($@ =~ /^Ambiguous range in transliteration operator/) 
-       ? '' : 'not ', "ok 16\n");
+       ? '' : 'not ', "ok 18\n");
 
-# 17-19: Make sure leading and trailing hyphens still work
+# 19-21: Make sure leading and trailing hyphens still work
 $_ = "car-rot9";
 tr/-a-m/./;
-print (($_ eq '..r.rot9') ? '' : 'not ', "ok 17\n");
+print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n");
 
 $_ = "car-rot9";
 tr/a-m-/./;
-print (($_ eq '..r.rot9') ? '' : 'not ', "ok 18\n");
+print (($_ eq '..r.rot9') ? '' : 'not ', "ok 20\n");
 
 $_ = "car-rot9";
 tr/-a-m-/./;
-print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n");
+print (($_ eq '..r.rot9') ? '' : 'not ', "ok 21\n");
 
 $_ = "abcdefghijklmnop";
 tr/ae-hn/./;
-print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 20\n");
+print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 22\n");
 
 $_ = "abcdefghijklmnop";
 tr/a-cf-kn-p/./;
-print (($_ eq '...de......lm...') ? '' : 'not ', "ok 21\n");
+print (($_ eq '...de......lm...') ? '' : 'not ', "ok 23\n");
 
 $_ = "abcdefghijklmnop";
 tr/a-ceg-ikm-o/./;
-print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 22\n");
+print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 24\n");
 
-# 23: Test reversed range check
+# 25: Test reversed range check
 # 20000705 MJD
 eval "tr/m-d/ /";
 print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/) 
-       ? '' : 'not ', "ok 23\n");
+       ? '' : 'not ', "ok 25\n");
 
-# 24: test cannot update if read-only
+# 26: test cannot update if read-only
 eval '$1 =~ tr/x/y/';
 print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ',
-       "ok 24\n");
+       "ok 26\n");
 
-# 25: test can count read-only
+# 27: test can count read-only
 'abcdef' =~ /(bcd)/;
-print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 25\n");
+print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 27\n");
 
-# 26: test lhs OK if not updating
-print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 26\n");
+# 28: test lhs OK if not updating
+print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 28\n");
 
-# 27: test lhs bad if updating
+# 29: test lhs bad if updating
 eval '"123" =~ tr/1/1/';
 print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|)
-       ? '' : 'not ', "ok 27\n");
+       ? '' : 'not ', "ok 29\n");