diff options
author | Graham Barr <gbarr@pobox.com> | 2009-05-13 19:40:49 -0500 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2009-06-23 21:02:04 +0100 |
commit | c1e3ea017c1126de09f1c3e27f74f1895dcdf431 (patch) | |
tree | 1cacca3042bf27b753388c42a0a73da2bcc51e96 /ext | |
parent | 666fe009e18b4a96d7af0b23103e64b04293c7d3 (diff) | |
download | perl-c1e3ea017c1126de09f1c3e27f74f1895dcdf431.tar.gz |
Update to IO-1.25 from CPAN
(cherry picked from commit 7475ca45e9b012ecdbb210a4c83732a8bee17c9c)
Diffstat (limited to 'ext')
-rw-r--r-- | ext/IO/ChangeLog | 4 | ||||
-rw-r--r-- | ext/IO/IO.pm | 2 | ||||
-rw-r--r-- | ext/IO/lib/IO/Dir.pm | 2 | ||||
-rw-r--r-- | ext/IO/lib/IO/Handle.pm | 2 | ||||
-rw-r--r-- | ext/IO/lib/IO/Socket.pm | 2 | ||||
-rw-r--r-- | ext/IO/t/io_dir.t | 47 | ||||
-rw-r--r-- | ext/IO/t/io_taint.t | 44 |
7 files changed, 60 insertions, 43 deletions
diff --git a/ext/IO/ChangeLog b/ext/IO/ChangeLog index 353e5b0bfc..6913c646e1 100644 --- a/ext/IO/ChangeLog +++ b/ext/IO/ChangeLog @@ -1,3 +1,7 @@ +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 diff --git a/ext/IO/IO.pm b/ext/IO/IO.pm index ad22653407..a72e2243d7 100644 --- a/ext/IO/IO.pm +++ b/ext/IO/IO.pm @@ -7,7 +7,7 @@ use Carp; use strict; use warnings; -our $VERSION = "1.24"; +our $VERSION = "1.25"; XSLoader::load 'IO', $VERSION; sub import { diff --git a/ext/IO/lib/IO/Dir.pm b/ext/IO/lib/IO/Dir.pm index 4948142f34..cce392c2ce 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_01"; +$VERSION = "1.07"; $VERSION = eval $VERSION; @EXPORT_OK = qw(DIR_UNLINK); diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm index 989c98a166..2f1f1b423b 100644 --- a/ext/IO/lib/IO/Handle.pm +++ b/ext/IO/lib/IO/Handle.pm @@ -268,7 +268,7 @@ use IO (); # Load the XS module require Exporter; @ISA = qw(Exporter); -$VERSION = "1.27_02"; +$VERSION = "1.28"; $VERSION = eval $VERSION; @EXPORT_OK = qw( diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index f1fcddedaf..2ef05a72fa 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 f4d2164232..10202b581e 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 1cec9d7baf..bcea016247 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; |