In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/494cc49e66f7e0e27ee0cefe230f5fc2a4458e84?hp=43f4a416023b1f5ec16eaf0f05488d0247bc7c42>
- Log ----------------------------------------------------------------- commit 494cc49e66f7e0e27ee0cefe230f5fc2a4458e84 Author: Karl Williamson <[email protected]> Date: Sun Sep 6 11:06:32 2015 -0600 embed.fnc: Add comment M embed.fnc commit ac8337961b24fa26985efc2b091d93df4d92da75 Author: Karl Williamson <[email protected]> Date: Sun Sep 6 21:44:54 2015 -0600 Test-Test.pm: Pedantic pod fixes M dist/Test/lib/Test.pm commit 781d2176f89fdc0cdaddee4804d0784c64b84e37 Author: Karl Williamson <[email protected]> Date: Wed Apr 3 19:06:52 2013 -0600 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. M dist/Test/lib/Test.pm commit 32a14dd4248ea43b0d03ed4b07a387cd22b22b8a Author: Karl Williamson <[email protected]> Date: Mon Sep 7 20:06:40 2015 -0600 Rmv trailing ';' on #endif This creates a compiler warning on AIX M ext/POSIX/POSIX.xs ----------------------------------------------------------------------- Summary of changes: dist/Test/lib/Test.pm | 46 ++++++++++++++++++++++++++++++++++++---------- embed.fnc | 3 ++- ext/POSIX/POSIX.xs | 2 +- 3 files changed, 39 insertions(+), 12 deletions(-) diff --git a/dist/Test/lib/Test.pm b/dist/Test/lib/Test.pm index 6d82139..cad2bcb 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}; @@ -273,14 +295,16 @@ the test fails. Examples: ok( $foo =~ /bar/ ); # ok if $foo contains 'bar' ok( baz($x + $y) eq 'Armondo' ); # ok if baz($x + $y) returns # 'Armondo' - ok( @a == @b ); # ok if @a and @b are the same length + ok( @a == @b ); # ok if @a and @b are the same + # length The expression is evaluated in scalar context. So the following will work: - ok( @stuff ); # ok if @stuff has any elements - ok( !grep !defined $_, @stuff ); # ok if everything in @stuff is - # defined. + ok( @stuff ); # ok if @stuff has any + # elements + ok( !grep !defined $_, @stuff ); # ok if everything in @stuff + # is defined. A special case is if the expression is a subroutine reference (in either C<sub {...}> syntax or C<\&foo> syntax). In @@ -634,7 +658,8 @@ Example usage: my $if_MSWin = $^O =~ m/MSWin/ ? 'Skip if under MSWin' : ''; - # A test to be skipped if under MSWin (i.e., run except under MSWin) + # A test to be skipped if under MSWin (i.e., run except under + # MSWin) skip($if_MSWin, thing($foo), thing($bar) ); Or, going the other way: @@ -642,7 +667,8 @@ Or, going the other way: my $unless_MSWin = $^O =~ m/MSWin/ ? '' : 'Skip unless under MSWin'; - # A test to be skipped unless under MSWin (i.e., run only under MSWin) + # A test to be skipped unless under MSWin (i.e., run only under + # MSWin) skip($unless_MSWin, thing($foo), thing($bar) ); The tricky thing to remember is that the first parameter is true if diff --git a/embed.fnc b/embed.fnc index 8f033df..ca6a5c7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -71,7 +71,8 @@ : : M May change: : -: any doc entry is marked that function may change +: any doc entry is marked that function may change. Also used to +: suppress making a doc entry if it would just be a placeholder. : : m Implemented as a macro: : diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index f1e00a0..7d76af3 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3176,7 +3176,7 @@ sigpending(sigset) RETVAL = not_here("sigpending"); #else RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset); -#endif; +#endif OUTPUT: RETVAL CLEANUP: -- Perl5 Master Repository
