some tests (was Re: Perl5.7.* Unicode/EBCDIC status.)

Message-ID: <Pine.OSF.4.10.10103281858520.314137-100000@aspara.forte.com>

p4raw-id: //depot/perl@9434

4 files changed, 67 insertions, 18 deletions

diff --git a/t/lib/charnames.t b/t/lib/charnames.t
index 9773a2025d..07c91e6682 100644
--- a/t/lib/charnames.t
+++ b/t/lib/charnames.t
@@ -39,10 +39,19 @@ EOE
 }
 
 # If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
-$encoded_be = "\320\261";
-$encoded_alpha = "\316\261";
-$encoded_bet = "\327\221";
-$encoded_deseng = "\360\220\221\215";
+if (ord('A') == 65) { # as on ASCII or UTF-8 machines
+    $encoded_be = "\320\261";
+    $encoded_alpha = "\316\261";
+    $encoded_bet = "\327\221";
+    $encoded_deseng = "\360\220\221\215";
+}
+else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
+       # UTF-EBCDIC is codepage specific)
+    $encoded_be = "\270\102\130";
+    $encoded_alpha = "\264\130";
+    $encoded_bet = "\270\125\130";
+    $encoded_deseng = "\336\102\103\124";
+}
 
 sub to_bytes {
     pack"a*", shift;
diff --git a/t/op/bop.t b/t/op/bop.t
index 0354f009f9..c433875aa8 100755
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -99,12 +99,20 @@ print "ok 35\n" if sprintf("%vd", $a) eq '248.444';
 # UTF8 ~ behaviour
 #
 
+my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
+
 my @not36;
 
 for (0x100...0xFFF) {
   $a = ~(chr $_);
-  push @not36, sprintf("%#03X", $_)
-      if $a ne chr(~$_) or length($a) != 1 or ~$a ne chr($_);
+  if ($Is_EBCDIC) {
+      push @not36, sprintf("%#03X", $_)
+          if $a ne chr(~$_) or length($a) != 1;
+  }
+  else {
+      push @not36, sprintf("%#03X", $_)
+          if $a ne chr(~$_) or length($a) != 1 or ~$a ne chr($_);
+  }
 }
 if (@not36) {
     print "# test 36 failed\n";
@@ -117,10 +125,17 @@ my @not37;
 for my $i (0xEEE...0xF00) {
   for my $j (0x0..0x120) {
     $a = ~(chr ($i) . chr $j);
-    push @not37, sprintf("%#03X %#03X", $i, $j)
-	if $a ne chr(~$i).chr(~$j) or
-	   length($a) != 2 or 
-           ~$a ne chr($i).chr($j);
+    if ($Is_EBCDIC) {
+        push @not37, sprintf("%#03X %#03X", $i, $j)
+	    if $a ne chr(~$i).chr(~$j) or
+	       length($a) != 2;
+    }
+    else {
+        push @not37, sprintf("%#03X %#03X", $i, $j)
+	    if $a ne chr(~$i).chr(~$j) or
+	       length($a) != 2 or 
+               ~$a ne chr($i).chr($j);
+    }
   }
 }
 if (@not37) {
@@ -129,7 +144,7 @@ if (@not37) {
 }
 print "ok 37\n";
 
-print "not " unless ~chr(~0) eq "\0";
+print "not " unless ~chr(~0) eq "\0" or $Is_EBCDIC;
 print "ok 38\n";
 
 my @not39;
diff --git a/t/op/vec.t b/t/op/vec.t
index 7fe0974770..4b8934d7a2 100755
--- a/t/op/vec.t
+++ b/t/op/vec.t
@@ -2,6 +2,8 @@
 
 print "1..30\n";
 
+my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
+
 print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n";
 print length($foo) == 0 ? "ok 2\n" : "not ok 2\n";
 vec($foo,0,1) = 1;
@@ -62,8 +64,14 @@ print "ok 25\n";
 eval { vec($foo, 1, 8) = 13 };
 print "not " if $@;
 print "ok 26\n";
-print "not " if $foo ne "\xc4\x0d\xc3\xbf\xc3\xbe";
-print "ok 27\n";
+if ($Is_EBCDIC) {
+    print "not " if $foo ne "\x8c\x0d\xff\x8a\x69";
+    print "ok 27\n";
+}
+else {
+    print "not " if $foo ne "\xc4\x0d\xc3\xbf\xc3\xbe";
+    print "ok 27\n";
+}
 $foo = "\x{100}" . "\xff\xfe";
 $x = substr $foo, 1;
 vec($x, 2, 4) = 7;
diff --git a/t/op/ver.t b/t/op/ver.t
index e248a48482..2eddabd22d 100755
--- a/t/op/ver.t
+++ b/t/op/ver.t
@@ -128,8 +128,14 @@ print "ok $test\n";  ++$test;
     }
     print "ok $test\n";  ++$test;
 
-    print "not " unless
-        sprintf("%vd", 1.22.333.4444) eq '1.22.197.141.225.133.156';
+    if (ord("\t") == 9) { # ASCII
+        print "not " unless
+            sprintf("%vd", 1.22.333.4444) eq '1.22.197.141.225.133.156';
+    }
+    else {
+        print "not " unless
+            sprintf("%vd", 1.22.333.4444) eq '1.22.142.84.187.81.112';
+    }
     print "ok $test\n";  ++$test;
 
     if (ord("\t") == 9) { # ASCII
@@ -140,7 +146,12 @@ print "ok $test\n";  ++$test;
     }
     print "ok $test\n";  ++$test;
 
-    print "not " unless sprintf("%vX", v1.22.333.4444) eq '1.16.C5.8D.E1.85.9C';
+    if (ord("\t") == 9) { # ASCII
+        print "not " unless sprintf("%vX", v1.22.333.4444) eq '1.16.C5.8D.E1.85.9C';
+    }
+    else {
+        print "not " unless sprintf("%vX", v1.22.333.4444) eq '1.16.8E.54.BB.51.70';
+    }
     print "ok $test\n";  ++$test;
 
     if (ord("\t") == 9) { # ASCII
@@ -151,8 +162,14 @@ print "ok $test\n";  ++$test;
     }
     print "ok $test\n";  ++$test;
 
-    print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
-	eq '1##10110##11000101##10001101##11100001##10000101##10011100';
+    if (ord("\t") == 9) { # ASCII
+        print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
+	    eq '1##10110##11000101##10001101##11100001##10000101##10011100';
+    }
+    else {
+        print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
+            eq '1##10110##10001110##1010100##10111011##1010001##1110000';
+    }
     print "ok $test\n";  ++$test;
 }