Perl 5.8.3 patches from the BS2000 port - part 2

Message-ID: <6727B1DACFCDD311A757009027CA8D69044B6740@Ex02.inhouse.start.de>
Date: Fri, 19 Dec 2003 07:16:47 +0100

p4raw-id: //depot/perl@22033

2 files changed, 14 insertions, 7 deletions

diff --git a/t/io/utf8.t b/t/io/utf8.t
index 7b2d6723fc..721d7dbd1f 100755
--- a/t/io/utf8.t
+++ b/t/io/utf8.t
@@ -321,17 +321,22 @@ ok( 1 );
     local $SIG{__WARN__} = sub { $@ = shift };
     open F, ">a";
     binmode F;
-    print F "foo", chr(0xE4), "\n";
-    print F "foo", chr(0xF6), "\n";
+    my ($chrE4, $chrF6) = (chr(0xE4), chr(0xF6));
+    if (ord('A') == 193)	# EBCDIC
+    { ($chrE4, $chrF6) = (chr(0x43), chr(0xEC)); }
+    print F "foo", $chrE4, "\n";
+    print F "foo", $chrF6, "\n";
     close F;
     open F, "<:utf8", "a";
     undef $@;
     my $line = <F>;
-    like( $@, qr/utf8 "\\xE4" does not map to Unicode .+ <F> line 1/,
+    my ($chrE4, $chrF6) = ("E4", "F6");
+    if (ord('A') == 193) { ($chrE4, $chrF6) = ("43", "EC"); } # EBCDIC
+    like( $@, qr/utf8 "\\x$chrE4" does not map to Unicode .+ <F> line 1/,
 	  "<:utf8 readline must warn about bad utf8");
     undef $@;
     $line .= <F>;
-    like( $@, qr/utf8 "\\xF6" does not map to Unicode .+ <F> line 2/,
+    like( $@, qr/utf8 "\\x$chrF6" does not map to Unicode .+ <F> line 2/,
 	  "<:utf8 rcatline must warn about bad utf8");
     close F;
 }
diff --git a/t/op/pat.t b/t/op/pat.t
index 7eeb79ffb7..7757c40236 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -1689,10 +1689,11 @@ EOT
     print "not " if     $x =~ /[\x{100}]/;
     print "ok 604\n";
 
-    print "not " unless $x =~ /\p{InLatin1Supplement}/;
+    # the next two tests must be ignored on EBCDIC
+    print "not " unless $x =~ /\p{InLatin1Supplement}/ or ord("A") == 193;
     print "ok 605\n";
 
-    print "not " if     $x =~ /\P{InLatin1Supplement}/;
+    print "not " if     $x =~ /\P{InLatin1Supplement}/ and ord("A") != 193;
     print "ok 606\n";
 
     print "not " if     $x =~ /\p{InLatinExtendedA}/;
@@ -1907,7 +1908,8 @@ print "ok 663\n";
 print "not " unless chr(0xfb4f) =~ /\p{IsHebrew}/; # outside InHebrew
 print "ok 664\n";
 
-print "not " unless chr(0xb5) =~ /\p{IsGreek}/; # singleton (not in a range)
+# singleton (not in a range, this test must be ignored on EBCDIC)
+print "not " unless chr(0xb5) =~ /\p{IsGreek}/ or ord("A") == 193;
 print "ok 665\n";
 
 print "not " unless chr(0x37a) =~ /\p{IsGreek}/; # singleton