| Subject: | Patch attached to get this to work on EBCDIC pagroms |
Test.pm did not work on EBCDIC platforms before this commit, because it hard-coded in ASCII platform values. Perl v5.22 will work on EBCDIC.
| Subject: | 0043-Test-Test.pm-EBCDIC-fixes.patch |
From 2fb087989a4d2ac1836f5d57fa2ffb227a027721 Mon Sep 17 00:00:00 2001
From: Karl Williamson <public@khwilliamson.com>
Date: Wed, 3 Apr 2013 19:06:52 -0600
Subject: [PATCH 043/160] Test::Test.pm: EBCDIC fixes
We are getting Perl working again for EBCDIC in v5.22. The changes here
are necessary to work for these platforms. For modern Perls, there is
one code path for both ASCII and EBCDIC platforms; this wasn't possible
to do for earlier versions.
One perhaps not obvious change is that [^:ascii:] doesn't include \177
which the earlier version does. However \177 was changed in the
substitute in the line above, so this change has no practical effect.
---
cpan/Test/lib/Test.pm | 28 +++++++++++++++++++++++++---
1 file changed, 25 insertions(+), 3 deletions(-)
diff --git a/cpan/Test/lib/Test.pm b/cpan/Test/lib/Test.pm
index 108bc10..6f8098d 100644
--- a/cpan/Test/lib/Test.pm
+++ b/cpan/Test/lib/Test.pm
@@ -239,9 +239,31 @@ sub _quote {
$str =~ s/\n/\\n/g;
$str =~ s/\r/\\r/g;
$str =~ s/\t/\\t/g;
- $str =~ s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
- $str =~ s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
- $str =~ s/([^\0-\176])/sprintf('\\x{%X}',ord($1))/eg;
+ if (defined $^V && $^V ge v5.6) {
+ $str =~ s/([[:cntrl:]])(?!\d)/sprintf('\\%o',ord($1))/eg;
+ $str =~ s/([[:^print:]])/sprintf('\\x%02X',ord($1))/eg;
+ $str =~ s/([[:^ascii:]])/sprintf('\\x{%X}',ord($1))/eg;
+ }
+ elsif (ord("A") == 65) {
+ $str =~ s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
+ $str =~ s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
+ $str =~ s/([^\0-\176])/sprintf('\\x{%X}',ord($1))/eg;
+ }
+ else { # Assuming EBCDIC on this ancient Perl
+
+ # The controls except for one are 0-\077, so almost all controls on
+ # EBCDIC platforms will be expressed in octal, instead of just the C0
+ # ones.
+ $str =~ s/([\0-\077])(?!\d)/sprintf('\\%o',ord($1))/eg;
+ $str =~ s/([\0-\077])/sprintf('\\x%02X',ord($1))/eg;
+
+ $str =~ s/([^\0-\xFF])/sprintf('\\x{%X}',ord($1))/eg;
+
+ # What remains to be escaped are the non-ASCII-range characters,
+ # including the one control that isn't in the 0-077 range.
+ # (We don't escape further any ASCII printables.)
+ $str =~ s<[^ !"\$\%#'()*+,\-./0123456789:;\<=\>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~]><sprintf('\\x%02X',ord($1))>eg;
+ }
#if( $_[1] ) {
# substr( $str , 218-3 ) = "..."
# if length($str) >= 218 and !$ENV{PERL_TEST_NO_TRUNC};
--
1.9.1