diff options
| -rw-r--r-- | INSTALL | 7 | ||||
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | README.os2 | 2 | ||||
| -rw-r--r-- | ext/Fcntl/t/syslfs.t | 6 | ||||
| -rw-r--r-- | ext/GDBM_File/GDBM_File.pm | 10 | ||||
| -rw-r--r-- | ext/GDBM_File/Makefile.PL | 7 | ||||
| -rw-r--r-- | ext/POSIX/t/is.t | 86 | ||||
| -rw-r--r-- | lib/Unicode/UCD.pm | 5 | ||||
| -rw-r--r-- | lib/Unicode/UCD.t | 12 | ||||
| -rw-r--r-- | pod/perldiag.pod | 14 | ||||
| -rwxr-xr-x | t/op/eval.t | 8 | ||||
| -rwxr-xr-x | t/op/grep.t | 8 | ||||
| -rw-r--r-- | t/op/lfs.t | 6 | ||||
| -rwxr-xr-x | t/op/subst.t | 11 |
14 files changed, 162 insertions, 21 deletions
@@ -1722,6 +1722,13 @@ tests whether utime() can change timestamps. The Y2K patch seems to break utime() so that over NFS the timestamps do not get changed (on local filesystems utime() still works). +Building Perl on a system that has also BIND (headers and libraries) +installed may run into troubles because BIND installs its own netdb.h +and socket.h, which may not agree with the operating system's ideas of +the same files. Similarly, including -lbind may conflict with libc's +view of the world. You may have to tweak -Dlocincpth and -Dloclibpth +to avoid the BIND. + =back =head2 Cross-compilation @@ -563,6 +563,7 @@ ext/POSIX/Makefile.PL POSIX extension makefile writer ext/POSIX/POSIX.pm POSIX extension Perl module ext/POSIX/POSIX.pod POSIX extension documentation ext/POSIX/POSIX.xs POSIX extension external subroutines +ext/POSIX/t/is.t See if POSIX isxxx() work ext/POSIX/t/posix.t See if POSIX works ext/POSIX/t/sigaction.t See if POSIX::sigaction works ext/POSIX/t/taint.t See if POSIX works with taint diff --git a/README.os2 b/README.os2 index e02c0819ad..bb1adb1248 100644 --- a/README.os2 +++ b/README.os2 @@ -907,7 +907,7 @@ of the current maintainer. Quick cycle of developers release may break the OS/2 build time to time, looking into - http://www.cpan.org/ports/os2/ilyaz/ + http://www.cpan.org/ports/os2/ may indicate the latest release which was publicly released by the maintainer. Note that the release may include some additional patches diff --git a/ext/Fcntl/t/syslfs.t b/ext/Fcntl/t/syslfs.t index 2dcaf43a3d..0843b6019e 100644 --- a/ext/Fcntl/t/syslfs.t +++ b/ext/Fcntl/t/syslfs.t @@ -262,10 +262,10 @@ bye(); # does the necessary cleanup END { # unlink may fail if applied directly to a large file - open(BIG, ">big"); - print BIG "x"; + # be paranoid about leaving 5 gig files lying around + open(BIG, ">big"); # truncate close(BIG); - unlink "big"; # be paranoid about leaving 5 gig files lying around + 1 while unlink "big"; # standard portable idiom } # eof diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm index 63225f0362..63541bb04a 100644 --- a/ext/GDBM_File/GDBM_File.pm +++ b/ext/GDBM_File/GDBM_File.pm @@ -31,6 +31,8 @@ http://www.gnu.org/order/ftp.html. The available functions and the gdbm/perl interface need to be documented. +The GDBM error number and error message interface needs to be added. + =head1 SEE ALSO L<perl(1)>, L<DB_File(3)>, L<perldbmfilter>. @@ -50,17 +52,23 @@ use XSLoader (); @ISA = qw(Tie::Hash Exporter); @EXPORT = qw( GDBM_CACHESIZE + GDBM_CENTFREE + GDBM_COALESCEBLKS GDBM_FAST + GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB GDBM_NOLOCK + GDBM_OPENMASK GDBM_READER GDBM_REPLACE + GDBM_SYNC + GDBM_SYNCMODE GDBM_WRCREAT GDBM_WRITER ); -$VERSION = "1.06"; +$VERSION = "1.07"; sub AUTOLOAD { my($constname); diff --git a/ext/GDBM_File/Makefile.PL b/ext/GDBM_File/Makefile.PL index ad1946733e..5c4f2d5134 100644 --- a/ext/GDBM_File/Makefile.PL +++ b/ext/GDBM_File/Makefile.PL @@ -12,7 +12,8 @@ WriteConstants( NAME => 'GDBM_File', DEFAULT_TYPE => 'IV', BREAKOUT_AT => 8, - NAMES => [qw(GDBM_CACHESIZE GDBM_FAST GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB - GDBM_NOLOCK GDBM_READER GDBM_REPLACE GDBM_WRCREAT - GDBM_WRITER)], + NAMES => [qw(GDBM_CACHESIZE GDBM_CENTFREE GDBM_COALESCEBLKS + GDBM_FAST GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB GDBM_NOLOCK + GDBM_OPENMASK GDBM_READER GDBM_REPLACE GDBM_SYNC GDBM_SYNCMODE + GDBM_WRCREAT GDBM_WRITER)], ); diff --git a/ext/POSIX/t/is.t b/ext/POSIX/t/is.t new file mode 100644 index 0000000000..6aa96f0b7c --- /dev/null +++ b/ext/POSIX/t/is.t @@ -0,0 +1,86 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) { + print "1..0\n"; + exit 0; + } +} + + +use POSIX; +use strict ; + +$| = 1; + + +# List of characters (and strings) to feed to the is<xxx> functions. +# +# The left-hand side (key) is a character or string. +# The right-hand side (value) is a list of character classes to which +# this string belongs. This is a *complete* list: any classes not +# listed, are expected to return '0' for the given string. +my %classes = + ( + 'a' => [ qw(print graph alnum alpha lower xdigit) ], + 'A' => [ qw(print graph alnum alpha upper xdigit) ], + 'z' => [ qw(print graph alnum alpha lower) ], + 'Z' => [ qw(print graph alnum alpha upper) ], + '0' => [ qw(print graph alnum digit xdigit) ], + '9' => [ qw(print graph alnum digit xdigit) ], + '.' => [ qw(print graph punct) ], + '?' => [ qw(print graph punct) ], + ' ' => [ qw(print space) ], + "\t" => [ qw(cntrl space) ], + "\001" => [ qw(cntrl) ], + + # Multi-character strings. These are logically ANDed, so the + # presence of different types of chars in one string will + # reduce the list on the right. + 'abc' => [ qw(print graph alnum alpha lower xdigit) ], + 'az' => [ qw(print graph alnum alpha lower) ], + 'aZ' => [ qw(print graph alnum alpha) ], + 'abc ' => [ qw(print) ], + + '012aF' => [ qw(print graph alnum xdigit) ], + + " \t" => [ qw(space) ], + + "abcde\001" => [], + ); + + +# Pass 1: convert the above arrays to hashes. While doing so, obtain +# a complete list of all the 'is<xxx>' functions. At least, the ones +# listed above. +my %functions; +foreach my $s (keys %classes) { + $classes{$s} = { map { + $functions{"is$_"}++; # Keep track of all the 'is<xxx>' functions + "is$_" => 1; # Our return value: is<xxx>($s) should pass. + } @{$classes{$s}} }; +} + +# Expected number of tests is one each for every combination of a +# known is<xxx> function and string listed above. +require './test.pl'; +plan(tests => keys(%classes) * keys(%functions)); + + +# +# Main test loop: Run all POSIX::is<xxx> tests on each string defined above. +# Only the character classes listed for that string should return 1. We +# always run all functions on every string, and expect to get 0 for the +# character classes not listed in the given string's hash value. +# +foreach my $s (sort keys %classes) { + foreach my $f (sort keys %functions) { + my $expected = exists $classes{$s}->{$f}; + my $actual = eval "POSIX::$f( \$s )"; + + ok( $actual == $expected, "$f('$s') == $actual"); + } +} diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm index 96dee9a816..b28c6f7d83 100644 --- a/lib/Unicode/UCD.pm +++ b/lib/Unicode/UCD.pm @@ -295,6 +295,7 @@ my %BLOCKS; sub _charblocks { unless (@BLOCKS) { if (openunicode(\$BLOCKSFH, "Blocks.txt")) { + local $_; while (<$BLOCKSFH>) { if (/^([0-9A-F]+)\.\.([0-9A-F]+);\s+(.+)/) { my ($lo, $hi) = (hex($1), hex($2)); @@ -356,6 +357,7 @@ my %SCRIPTS; sub _charscripts { unless (@SCRIPTS) { if (openunicode(\$SCRIPTSFH, "Scripts.txt")) { + local $_; while (<$SCRIPTSFH>) { if (/^([0-9A-F]+)(?:\.\.([0-9A-F]+))?\s+;\s+(\w+)/) { my ($lo, $hi) = (hex($1), $2 ? hex($2) : hex($1)); @@ -493,6 +495,7 @@ my %COMPEXCL; sub _compexcl { unless (%COMPEXCL) { if (openunicode(\$COMPEXCLFH, "CompositionExclusions.txt")) { + local $_; while (<$COMPEXCLFH>) { if (/^([0-9A-F]+)\s+\#\s+/) { my $code = hex($1); @@ -563,6 +566,7 @@ my %CASEFOLD; sub _casefold { unless (%CASEFOLD) { if (openunicode(\$CASEFOLDFH, "CaseFolding.txt")) { + local $_; while (<$CASEFOLDFH>) { if (/^([0-9A-F]+); ([CFSI]); ([0-9A-F]+(?: [0-9A-F]+)*);/) { my $code = hex($1); @@ -643,6 +647,7 @@ my %CASESPEC; sub _casespec { unless (%CASESPEC) { if (openunicode(\$CASESPECFH, "SpecialCasing.txt")) { + local $_; while (<$CASESPECFH>) { if (/^([0-9A-F]+); ([0-9A-F]+(?: [0-9A-F]+)*)?; ([0-9A-F]+(?: [0-9A-F]+)*)?; ([0-9A-F]+(?: [0-9A-F]+)*)?; (\w+(?: \w+)*)?/) { my ($hexcode, $lower, $title, $upper, $condition) = diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t index 9082057bbd..b9bf574d13 100644 --- a/lib/Unicode/UCD.t +++ b/lib/Unicode/UCD.t @@ -12,7 +12,7 @@ use strict; use Unicode::UCD; use Test::More; -BEGIN { plan tests => 162 }; +BEGIN { plan tests => 164 }; use Unicode::UCD 'charinfo'; @@ -279,3 +279,13 @@ ok($casespec->{az}->{code} eq '0307' && $casespec->{az}->{upper} eq '0307' && $casespec->{az}->{condition} eq 'az After_Soft_Dotted', 'casespec 0x307'); + +# perl #7305 UnicodeCD::compexcl is weird + +for (1) {$a=compexcl $_} +ok(1, 'compexcl read-only $_: perl #7305'); +grep {compexcl $_} %{{1=>2}}; +ok(1, 'compexcl read-only hash: perl #7305'); + + + diff --git a/pod/perldiag.pod b/pod/perldiag.pod index e59eee3b8b..6d755f0fdc 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1504,17 +1504,19 @@ PDP-11 or something? =item Filehandle %s opened only for input -(W io) You tried to write on a read-only filehandle. If you intended it -to be a read-write filehandle, you needed to open it with "+<" or "+>" -or "+>>" instead of with "<" or nothing. If you intended only to write -the file, use ">" or ">>". See L<perlfunc/open>. +(W io) You tried to write on a read-only filehandle. If you intended +it to be a read-write filehandle, you needed to open it with "+<" or +"+>" or "+>>" instead of with "<" or nothing. If you intended only to +write the file, use ">" or ">>". See L<perlfunc/open>. =item Filehandle %s opened only for output -(W io) You tried to read from a filehandle opened only for writing. -If you intended it to be a read/write filehandle, you needed to open it +(W io) You tried to read from a filehandle opened only for writing, If +you intended it to be a read/write filehandle, you needed to open it with "+<" or "+>" or "+>>" instead of with "<" or nothing. If you intended only to read from the file, use "<". See L<perlfunc/open>. +Another possibility is that you attempted to open filedescriptor 0 +(also known as STDIN) for output (maybe you closed STDIN earlier?). =item Filehandle %s reopened as %s only for input diff --git a/t/op/eval.t b/t/op/eval.t index 6487b9e8e4..79e219e97d 100755 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -1,6 +1,6 @@ #!./perl -print "1..77\n"; +print "1..78\n"; eval 'print "ok 1\n";'; @@ -242,6 +242,12 @@ print $@; eval q{}; print length($@) ? "not ok 46\t# \$\@ = '$@'\n" : "ok 46\n"; } +# [perl #9728] used to dump core +{ + $eval = eval 'sub { eval "sub { %S }" }'; + $eval->({}); + print "ok 47\n"; +} # DAPM Nov-2002. Perl should now capture the full lexical context during # evals. diff --git a/t/op/grep.t b/t/op/grep.t index d4885277f8..6e608132fc 100755 --- a/t/op/grep.t +++ b/t/op/grep.t @@ -4,7 +4,7 @@ # grep() and map() tests # -print "1..32\n"; +print "1..33\n"; $test = 1; @@ -128,4 +128,10 @@ sub ok { print "# @x,$y\n"; print "@x,$y" eq "3 4,1212" ? "ok $test\n" : "not ok $test\n"; $test++; + + # Add also a sample test from [perl #18153]. (The same bug). + $a = 1; map {if ($a){}} (2); + print "ok $test\n"; # no core dump is all we need + $test++; } + diff --git a/t/op/lfs.t b/t/op/lfs.t index e62cdbf900..f463b1b7b3 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -269,10 +269,10 @@ bye(); # does the necessary cleanup END { # unlink may fail if applied directly to a large file - open(BIG, ">big"); - print BIG "x"; + # be paranoid about leaving 5 gig files lying around + open(BIG, ">big"); # truncate close(BIG); - unlink "big"; # be paranoid about leaving 5 gig files lying around + 1 while unlink "big"; # standard portable idiom } # eof diff --git a/t/op/subst.t b/t/op/subst.t index 63fb6c62eb..ef0ae0a064 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -7,7 +7,7 @@ BEGIN { } require './test.pl'; -plan( tests => 122 ); +plan( tests => 124 ); $x = 'foo'; $_ = "x"; @@ -491,3 +491,12 @@ SKIP: { is($b, "$na--$na--$nb", "s///: replace long non-utf8 into non-utf8 (utf8 pattern)"); } +$_ = 'aaaa'; +$r = 'x'; +$s = s/a(?{})/$r/g; +is("<$_> <$s>", "<xxxx> <4>", "perl #7806"); + +$_ = 'aaaa'; +$s = s/a(?{})//g; +is("<$_> <$s>", "<> <4>", "perl #7806"); + |