(Retracted by #8395.)
Jarkko Hietaniemi [Sun, 25 Feb 2001 17:23:45 +0000 (17:23 +0000)]
Expand the EBCDIC character range tests, and add few nasty
tr tests from Karsten Sperling.

p4raw-id: //depot/perl@8929

t/op/pat.t
t/op/tr.t

index 237ea44..590c268 100755 (executable)
@@ -4,7 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..242\n";
+print "1..244\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -1183,23 +1183,29 @@ if (/(\C)/g) {
   }
 }
 
-# 241..242
-#
-# The tr is admittedly NOT a regular expression operator,
-# but this test is more of an EBCDIC test, the background is
-# that \x89 is 'i' and \x90 is 'j', and \x8e is not a letter,
-# not even a printable character.  Now for the trick:
-# if the range is specified using letters, the \x8e should most
-# probably not match, but if the range is specified using explicit
-# numeric endpoints, it probably should match.  The first case,
-# not matching if using letters, is already tested elsewhere,
-# here we test for the matching cases.
-
-$_ = qq/\x8E/;
-
-print "not " unless /[\x89-\x91]/;
-print "ok 241\n";
-
-print "not " unless tr/\x89-\x91//d == 1;
-print "ok 242\n";
-
+if (ord('i') == 0x89 && ord('j') == 0x91) { # EBCDIC
+  if ("\x8e" =~ /[\x89-\x91]/) {
+    print "ok 241\n";
+  } else {
+    print "not ok 241\n";
+  }
+  if ("\x8e" !~ /[i-j]/) {
+    print "ok 242\n";
+  } else {
+    print "not ok 242\n";
+  }
+  if ("\xce" =~ /[\xc9-\xd1]/) {
+    print "ok 243\n";
+  } else {
+    print "not ok 243\n";
+  }
+  if ("\xce" !~ /[I-J]/) {
+    print "ok 244\n";
+  } else {
+    print "not ok 244\n";
+  }
+} else {
+  for (241..244) {
+    print "ok $_ # Skip: not EBCDIC\n";
+  }
+}
index 75887ab..514d15c 100755 (executable)
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..51\n";
+print "1..58\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
@@ -296,3 +296,44 @@ 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";
+
+# Tricky on EBCDIC: while [a-z] must not match the gap characters,
+# (i-j, r-s, I-J, R-S), [\x89-\x91] has to match them, from Karsten
+# Sperling.
+
+if (ord('i') == 0x89 & ord('j') == 0x91) {
+
+$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 52\n";
+   
+$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 53\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 54\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 55\n";
+
+} else {
+  for (52..55) { print "ok $_ # Skip: not EBCDIC\n" }
+}
+
+# some more wide-char tests from Karsten Sperling
+
+($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}/X/c;
+print "not " unless $a eq "X";
+print "ok 56\n";
+
+($a = "\x{0100}") =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
+print "not " unless $a eq "X";
+print "ok 57\n";
+($a = v256) =~ tr/\x{0000}-\x{00ff}\x{0101}/X/c;
+print "not " unless $a eq "X";
+print ok "58\n"; 
+