summaryrefslogtreecommitdiff
path: root/t/op/tr.t
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-02-25 17:23:45 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-02-25 17:23:45 +0000
commit569bd3158af2276a406770e3d68e76b7da59b730 (patch)
treec96ecaaecf9a219b1ac3360455e1038a3b06ba8b /t/op/tr.t
parentc4974618b26b4f660bdffe46b2ebc915f15a9ca9 (diff)
downloadperl-569bd3158af2276a406770e3d68e76b7da59b730.tar.gz
(Retracted by #8395.)
Expand the EBCDIC character range tests, and add few nasty tr tests from Karsten Sperling. p4raw-id: //depot/perl@8929
Diffstat (limited to 't/op/tr.t')
-rwxr-xr-xt/op/tr.t43
1 files changed, 42 insertions, 1 deletions
diff --git a/t/op/tr.t b/t/op/tr.t
index 75887ab31c..514d15ce16 100755
--- 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";
+