EBCDIC tweaks.

Subject: [PATCH: perl@7674 ++] fixes for warnings and regmesg (reprise)
Message-ID: <Pine.OSF.4.10.10011141653510.106218-100000@aspara.forte.com>

p4raw-id: //depot/perl@7696

diff --git a/t/op/regmesg.t b/t/op/regmesg.t
index f209239..6b7f52b 100644 (file)
--- a/t/op/regmesg.t
+++ b/t/op/regmesg.t
@@ -65,7 +65,7 @@ my @death =
 
  '/(x)\2/' => 'Reference to nonexistent group before {#} mark in regex m/(x)\2{#}/',
 
- 'my $m = chr(92); $m =~ $m', => 'Trailing \ in regex m/\/',
+ 'my $m = "\\\"; $m =~ $m', => 'Trailing \ in regex m/\/',
 
  '/\x{1/' => 'Missing right brace on \x{} before {#} mark in regex m/\x{{#}1/',
 
@@ -101,15 +101,24 @@ my @death =
 
 my $total = (@death + @warning)/2;
 
+# utf8 is a noop on EBCDIC platforms, it is not fatal
+my $Is_EBCDIC = (ord('A') == 193);
+if ($Is_EBCDIC) {
+    my @utf8_death = grep(/utf8/, @death); 
+    $total = $total - $#utf8_death;
+}
+
 print "1..$total\n";
 
 my $count = 0;
 
 while (@death)
 {
-    $count++;
     my $regex = shift @death;
     my $result = shift @death;
+    # skip the utf8 test on EBCDIC since they do not die
+    next if ($Is_EBCDIC && $regex =~ /utf8/);
+    $count++;
 
     $_ = "x";
     eval $regex;

diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8
index 012c655..8d6d7db 100644 (file)
--- a/t/pragma/warn/utf8
+++ b/t/pragma/warn/utf8
@@ -15,6 +15,12 @@
 
 __END__
 # utf8.c [utf8_to_uv] -W
+BEGIN {
+    if (ord('A') == 193) {
+        print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings.";
+        exit 0;
+    }
+}
 use utf8 ;
 my $a = "snøstorm" ;
 {