diff options
| -rw-r--r-- | dist/Test/lib/Test.pm | 30 |
1 files changed, 26 insertions, 4 deletions
diff --git a/dist/Test/lib/Test.pm b/dist/Test/lib/Test.pm index 6d82139ba5..553fe08f3a 100644 --- a/dist/Test/lib/Test.pm +++ b/dist/Test/lib/Test.pm @@ -20,7 +20,7 @@ sub _reset_globals { $planned = 0; } -$VERSION = '1.26'; +$VERSION = '1.27'; require Exporter; @ISA=('Exporter'); @@ -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}; |