In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c1e3ea017c1126de09f1c3e27f74f1895dcdf431?hp=ce9a710cf3fef4991e1de00d7de8623bbab120c8>
- Log ----------------------------------------------------------------- commit c1e3ea017c1126de09f1c3e27f74f1895dcdf431 Author: Graham Barr <[email protected]> Date: Wed May 13 19:40:49 2009 -0500 Update to IO-1.25 from CPAN (cherry picked from commit 7475ca45e9b012ecdbb210a4c83732a8bee17c9c) M ext/IO/ChangeLog M ext/IO/IO.pm M ext/IO/lib/IO/Dir.pm M ext/IO/lib/IO/Handle.pm M ext/IO/lib/IO/Socket.pm M ext/IO/t/io_dir.t M ext/IO/t/io_taint.t commit 666fe009e18b4a96d7af0b23103e64b04293c7d3 Author: Graham Barr <[email protected]> Date: Mon May 11 14:20:34 2009 -0500 Update IO to CPAN 1.24 release (cherry picked from commit eb1c4873a4d2b3d386b680baf0b251a75d67e654) M ext/IO/ChangeLog M ext/IO/IO.pm M ext/IO/Makefile.PL commit 6f7ba526c293a4c044ac589e395f9d83860af535 Author: Zsban Ambrus <[email protected]> Date: Mon Feb 16 12:18:19 2009 +0100 [perl #63234] [DOC PATCH] fix some missing parts of IO::Handle pod This documents the previously undocumented fcntl and ioctl methods, and adds a see also to the IO::File module where the documentation refers to one of its methods. (cherry picked from commit 2b93ed3263b8b063954e409dedd232e5b362a927) M ext/IO/lib/IO/Handle.pm commit 841835c39b9135cee1068f4b5a7be5c177a570e1 Author: Gisle Aas <[email protected]> Date: Sat Sep 20 18:13:37 2008 +0000 Implement IO::Handle::say the same way as the builtin say(). IO::Handle::say used to output $, before the newline. p4raw-id: //depot/p...@34384 (cherry picked from commit 5eb30066fe9d342a31fbfdb741041326bde4087b) M ext/IO/lib/IO/Handle.pm commit 85c56648f7d8aeba6e5ad0129bd74bc4bc7558cd Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 1 19:49:50 2008 +0000 Bump version of IO::Dir after last patch p4raw-id: //depot/p...@33984 (cherry picked from commit 6f86311fbdd3b75e40d98b74ffba510124459a75) M ext/IO/lib/IO/Dir.pm commit 807037a0c5ee6715102afe69afd57a131ba461ca Author: Zefram <[email protected]> Date: Sat Sep 8 00:06:36 2007 +0100 IO::Dir destructor Message-ID: <[email protected]> p4raw-id: //depot/p...@33983 (cherry picked from commit bc3f1c14f93bf857a045b618293617218d759095) M ext/IO/lib/IO/Dir.pm commit 38d7a3066bc4fa2fcc3fc29cb7d12ab60810f253 Author: Rafael Garcia-Suarez <[email protected]> Date: Fri Feb 8 16:15:52 2008 +0000 IO::Handle->say should ignore $\ (bug #49266) p4raw-id: //depot/p...@33258 (cherry picked from commit 7b0f711abd55488cc790ac95f935f46d630a87bb) M ext/IO/lib/IO/Handle.pm ----------------------------------------------------------------------- Summary of changes: ext/IO/ChangeLog | 32 ++++++++++++++++++++++++++++++++ ext/IO/IO.pm | 2 +- ext/IO/Makefile.PL | 44 +++++++++++++++++++++++++++++++++++++++++--- ext/IO/lib/IO/Dir.pm | 3 ++- ext/IO/lib/IO/Handle.pm | 12 +++++++----- ext/IO/lib/IO/Socket.pm | 2 +- ext/IO/t/io_dir.t | 47 ++++++++++++++++++++++++----------------------- ext/IO/t/io_taint.t | 44 ++++++++++++++++++++++++++++---------------- 8 files changed, 136 insertions(+), 50 deletions(-) diff --git a/ext/IO/ChangeLog b/ext/IO/ChangeLog index 0dcb9df..6913c64 100644 --- a/ext/IO/ChangeLog +++ b/ext/IO/ChangeLog @@ -1,3 +1,35 @@ +IO 1.25 -- Wed May 13 18:37:33 CDT 2009 + * Fix test warnings in io_dir + * skip tests known to cause a segfault 5.10.0 + +IO 1.24 -- Mon May 11 14:15:51 CDT 2009 + + * Make Makefile.PL usable by core and CPAN + * Reorganize files to be under lib/ directory structure now matches core perl + * Update with following changes made to core perl distribution + * Silence Win32 compiler warning in IO.xs + * Make non-blocking mode work on Windows in IO::Socket::INET + * fix some missing parts of IO::Handle pod + * Implement IO::Handle::say the same way as the builtin say(). + * Undo io_linenum.t part of #34148. It was io_multihomed.t that I meant (my mistake), and that is now covered by #34155. + * watchdog() some IO tests + * Some more missing isGV_with_GP()s + * IO::Dir destructor + * IO::Socket::INET unnecessarily resolves "udp" + * IO::Handle->say should ignore $\ (bug #49266) + * consting IO.xs + * Net::SMTP can't send large messages with bleadperl + * Fix for IO::Socket send method + * Fixes for the test suite on OS/2 + * Silence VC++ compiler warnings + * IO::Socket's IO.xs fails to compile + * IO::Socket::connect returns wrong errno on timeout + * Coverity correctly reports that gv might (just) be NULL. So don't derefernece it if it is. + * Simplify tests for fork() capabilities + * Fix syntax error in io_pipe test + * Making IO::Socket pass test on Win32 + * ext/IO/t/io_unix.t + IO 1.23 -- Sat Mar 25 19:28:28 CST 2006 * Adjust the regression tests to use t/test.pl when $ENV{PERL_CORE} is defined diff --git a/ext/IO/IO.pm b/ext/IO/IO.pm index 5f42651..a72e224 100644 --- a/ext/IO/IO.pm +++ b/ext/IO/IO.pm @@ -7,7 +7,7 @@ use Carp; use strict; use warnings; -our $VERSION = "1.23_02"; +our $VERSION = "1.25"; XSLoader::load 'IO', $VERSION; sub import { diff --git a/ext/IO/Makefile.PL b/ext/IO/Makefile.PL index bc47a1b..2159f43 100644 --- a/ext/IO/Makefile.PL +++ b/ext/IO/Makefile.PL @@ -1,7 +1,45 @@ +# This -*- perl -*- script makes the Makefile + +BEGIN { require 5.006_001 } use ExtUtils::MakeMaker; +use Config qw(%Config); +my $PERL_CORE = grep { $_ eq 'PERL_CORE=1' } @ARGV; + +#--- Attempt to find <poll.h> + +my $define = ""; + +unless ($PERL_CORE or exists $Config{'i_poll'}) { + my @inc = split(/\s+/, join(" ", $Config{'usrinc'}, $Config{'incpth'}, $Config{'locincpth'})); + foreach $path (@inc) { + if (-f $path . "/poll.h") { + $define .= "-DI_POLL "; + last; + } + } +} + +if ($] < 5.008 and !$PERL_CORE) { + open(FH,">typemap"); + print FH "const char * T_PV\n"; + close(FH); +} + +#--- Write the Makefile WriteMakefile( - VERSION_FROM => "IO.pm", - NAME => "IO", - OBJECT => '$(O_FILES)', + VERSION_FROM => "IO.pm", + NAME => "IO", + OBJECT => '$(O_FILES)', + ABSTRACT => 'Perl core IO modules', + AUTHOR => 'Graham Barr <[email protected]>', + ( $PERL_CORE + ? () + : ( + INSTALLDIRS => 'perl', + clean => {FILES => 'typemap'}, + ) + ), + ($define ? (DEFINE => $define) : ()), + ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? ('LICENSE' => 'perl') : ()), ); diff --git a/ext/IO/lib/IO/Dir.pm b/ext/IO/lib/IO/Dir.pm index 06892f5..cce392c 100644 --- a/ext/IO/lib/IO/Dir.pm +++ b/ext/IO/lib/IO/Dir.pm @@ -19,7 +19,7 @@ use File::stat; use File::Spec; @ISA = qw(Tie::Hash Exporter); -$VERSION = "1.06"; +$VERSION = "1.07"; $VERSION = eval $VERSION; @EXPORT_OK = qw(DIR_UNLINK); @@ -38,6 +38,7 @@ sub new { sub DESTROY { my ($dh) = @_; + local($., $@, $!, $^E, $?); no warnings 'io'; closedir($dh); } diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm index e47ae87..2f1f1b4 100644 --- a/ext/IO/lib/IO/Handle.pm +++ b/ext/IO/lib/IO/Handle.pm @@ -63,9 +63,11 @@ corresponding built-in functions: $io->close $io->eof + $io->fcntl( FUNCTION, SCALAR ) $io->fileno $io->format_write( [FORMAT_NAME] ) $io->getc + $io->ioctl( FUNCTION, SCALAR ) $io->read ( BUF, LEN, [OFFSET] ) $io->print ( ARGS ) $io->printf ( FMT, [ARGS] ) @@ -107,7 +109,8 @@ Furthermore, for doing normal I/O you might need these: C<fdopen> is like an ordinary C<open> except that its first parameter is not a filename but rather a file handle name, an IO::Handle object, -or a file descriptor number. +or a file descriptor number. (For the documentation of the C<open> +method, see L<IO::File>.) =item $io->opened @@ -265,7 +268,7 @@ use IO (); # Load the XS module require Exporter; @ISA = qw(Exporter); -$VERSION = "1.27"; +$VERSION = "1.28"; $VERSION = eval $VERSION; @EXPORT_OK = qw( @@ -412,7 +415,8 @@ sub printf { sub say { @_ or croak 'usage: $io->say(ARGS)'; my $this = shift; - print $this @_, "\n"; + local $\ = "\n"; + print $this @_; } sub getline { @@ -587,14 +591,12 @@ sub format_write { } } -# XXX undocumented sub fcntl { @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; my ($io, $op) = @_; return fcntl($io, $op, $_[2]); } -# XXX undocumented sub ioctl { @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; my ($io, $op) = @_; diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index f1fcdde..2ef05a7 100644 --- a/ext/IO/lib/IO/Socket.pm +++ b/ext/IO/lib/IO/Socket.pm @@ -23,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); @ISA = qw(IO::Handle); -$VERSION = "1.30_01"; +$VERSION = "1.31"; @EXPORT_OK = qw(sockatmark); diff --git a/ext/IO/t/io_dir.t b/ext/IO/t/io_dir.t index f4d2164..10202b5 100644 --- a/ext/IO/t/io_dir.t +++ b/ext/IO/t/io_dir.t @@ -10,64 +10,65 @@ BEGIN { print "1..0 # Skip: readdir() not available\n"; exit 0; } -} - -select(STDERR); $| = 1; -select(STDOUT); $| = 1; -use IO::Dir qw(DIR_UNLINK); + require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl"); + plan(16); -my $tcount = 0; - -sub ok { - $tcount++; - my $not = $_[0] ? '' : 'not '; - print "${not}ok $tcount\n"; + use_ok('IO::Dir'); + IO::Dir->import(DIR_UNLINK); } -print "1..10\n"; +use strict; my $DIR = $^O eq 'MacOS' ? ":" : "."; -$dot = new IO::Dir $DIR; +my $CLASS = "IO::Dir"; +my $dot = $CLASS->new($DIR); ok(defined($dot)); -...@a = sort <*>; +my @a = sort <*>; +my $first; do { $first = $dot->read } while defined($first) && $first =~ /^\./; ok(+(grep { $_ eq $first } @a)); -...@b = sort($first, (grep {/^[^.]/} $dot->read)); +my @b = sort($first, (grep {/^[^.]/} $dot->read)); ok(+(join("\0", @a) eq join("\0", @b))); -$dot->rewind; -...@c = sort grep {/^[^.]/} $dot->read; +ok($dot->rewind,'rewind'); +my @c = sort grep {/^[^.]/} $dot->read; ok(+(join("\0", @b) eq join("\0", @c))); -$dot->close; -$dot->rewind; +ok($dot->close,'close'); +{ local $^W; # avoid warnings on invalid dirhandle +ok(!$dot->rewind, "rewind on closed"); ok(!defined($dot->read)); +} open(FH,'>X') || die "Can't create x"; print FH "X"; close(FH) or die "Can't close: $!"; -tie %dir, IO::Dir, $DIR; +my %dir; +tie %dir, $CLASS, $DIR; my @files = keys %dir; # I hope we do not have an empty dir :-) ok(scalar @files); my $stat = $dir{'X'}; -ok(defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1); +isa_ok($stat,'File::stat'); +ok(defined($stat) && $stat->size == 1); delete $dir{'X'}; ok(-f 'X'); -tie %dirx, IO::Dir, $DIR, DIR_UNLINK; +my %dirx; +tie %dirx, $CLASS, $DIR, DIR_UNLINK; my $statx = $dirx{'X'}; -ok(defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1); +isa_ok($statx,'File::stat'); +ok(defined($statx) && $statx->size == 1); delete $dirx{'X'}; diff --git a/ext/IO/t/io_taint.t b/ext/IO/t/io_taint.t index 1cec9d7..bcea016 100644 --- a/ext/IO/t/io_taint.t +++ b/ext/IO/t/io_taint.t @@ -16,42 +16,54 @@ BEGIN { } } +use strict; +if ($ENV{PERL_CORE}) { + require("./test.pl"); +} +else { + require("./t/test.pl"); +} +plan(tests => 5); + END { unlink "./__taint__$$" } -print "1..5\n"; use IO::File; -$x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n"); +my $x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n"); print $x "$$\n"; $x->close; $x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n"); -chop($unsafe = <$x>); +chop(my $unsafe = <$x>); eval { kill 0 * $unsafe }; -print "not " if ((($^O ne 'MSWin32') && ($^O ne 'NetWare')) and ($@ !~ /^Insecure/o)); -print "ok 1\n"; +SKIP: { + skip($^O) if $^O eq 'MSWin32' or $^O eq 'NetWare'; + like($@, '^Insecure'); +} $x->close; # We could have just done a seek on $x, but technically we haven't tested # seek yet... $x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n"); $x->untaint; -print "not " if ($?); -print "ok 2\n"; # Calling the method worked +ok(!$?); # Calling the method worked chop($unsafe = <$x>); eval { kill 0 * $unsafe }; -print "not " if ($@ =~ /^Insecure/o); -print "ok 3\n"; # No Insecure message from using the data +unlike($@,'^Insecure'); $x->close; -# this will segfault if it fails +TODO: { + todo_skip("Known bug in 5.10.0",2) if $] >= 5.010 and $] < 5.010_001; + + # this will segfault if it fails -sub PVBM () { 'foo' } -{ my $dummy = index 'foo', PVBM } + sub PVBM () { 'foo' } + { my $dummy = index 'foo', PVBM } -eval { IO::Handle::untaint(PVBM) }; -print "ok 4\n"; + eval { IO::Handle::untaint(PVBM) }; + pass(); -eval { IO::Handle::untaint(\PVBM) }; -print "ok 5\n"; + eval { IO::Handle::untaint(\PVBM) }; + pass(); +} exit 0; -- Perl5 Master Repository
