X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Ftr.t;h=e1144641c342c92935e187e578097842ad9389c9;hb=36c66720946952b050ad9db88444230a58b3c69d;hp=75887ab31c8e52660ed25ad7fcd16d273c2b85c3;hpb=b82d478d407f1381d69179104035c975c1d1402e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/tr.t b/t/op/tr.t
index 75887ab..e114464 100755
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..51\n";
+print "1..61\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
@@ -84,7 +84,7 @@ if (ord("\t") == 9) { # ASCII
     use utf8;
 }
 # 11 - changing UTF8 characters in a UTF8 string, same length.
-$l = chr(300); $r = chr(400);
+my $l = chr(300); my $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;
@@ -287,7 +287,7 @@ print "ok 48\n";
 print "not " unless sprintf("%vd", $a) eq '196.172.200';
 print "ok 49\n";
 
-# UTF8 range
+# UTF8 range tests from Inaba Hiroto
 
 ($a = v300.196.172.302.197.172) =~ tr/\x{12c}-\x{130}/\xc0-\xc4/;
 print "not " unless $a eq v192.196.172.194.197.172;
@@ -296,3 +296,57 @@ print "ok 50\n";
 ($a = v300.196.172.302.197.172) =~ tr/\xc4-\xc8/\x{12c}-\x{130}/;
 print "not " unless $a eq v300.300.172.302.301.172;
 print "ok 51\n";
+
+# UTF8 range tests from Karsten Sperling (patch #9008 required)
+
+($a = "\x{0100}") =~ tr/\x00-\x{100}/X/;
+print "not " unless $a eq "X";
+print "ok 52\n";
+
+($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}/X/c;
+print "not " unless $a eq "X";
+print "ok 53\n";
+
+($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
+print "not " unless $a eq "X";
+print "ok 54\n";
+ 
+($a = v256) =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
+print "not " unless $a eq "X";
+print "ok 55\n"; 
+
+# UTF8 range tests from Inaba Hiroto
+
+($a = "\x{200}") =~ tr/\x00-\x{100}/X/c;
+print "not " unless $a eq "X";
+print "ok 56\n";
+
+($a = "\x{200}") =~ tr/\x00-\x{100}/X/cs;
+print "not " unless $a eq "X";
+print "ok 57\n";
+
+# Tricky on EBCDIC: while [a-z] [A-Z] must not match the gap characters,
+# (i-j, r-s, I-J, R-S), [\x89-\x91] [\xc9-\xd1] has to match them,
+# from Karsten Sperling.
+
+$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/\x89-\x91/X/;
+print "not " unless $c == 8 and $a eq "XXXXXXXX";
+print "ok 58\n";
+   
+$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/\xc9-\xd1/X/;
+print "not " unless $c == 8 and $a eq "XXXXXXXX";
+print "ok 59\n";
+   
+if (ord('i') == 0x89 & ord('J') == 0xd1) {
+
+$c = ($a = "\x89\x8a\x8b\x8c\x8d\x8f\x90\x91") =~ tr/i-j/X/;
+print "not " unless $c == 2 and $a eq "X\x8a\x8b\x8c\x8d\x8f\x90X";
+print "ok 60\n";
+   
+$c = ($a = "\xc9\xca\xcb\xcc\xcd\xcf\xd0\xd1") =~ tr/I-J/X/;
+print "not " unless $c == 2 and $a eq "X\xca\xcb\xcc\xcd\xcf\xd0X";
+print "ok 61\n";
+
+} else {
+  for (60..61) { print "ok $_ # Skip: not EBCDIC\n" }
+}