diff options
Diffstat (limited to 'dist/IO')
-rw-r--r-- | dist/IO/IO.pm | 2 | ||||
-rw-r--r-- | dist/IO/Makefile.PL | 2 | ||||
-rw-r--r-- | dist/IO/lib/IO/Socket.pm | 6 | ||||
-rw-r--r-- | dist/IO/t/io_const.t | 1 | ||||
-rw-r--r-- | dist/IO/t/io_dir.t | 10 | ||||
-rw-r--r-- | dist/IO/t/io_dup.t | 12 | ||||
-rw-r--r-- | dist/IO/t/io_linenum.t | 2 | ||||
-rw-r--r-- | dist/IO/t/io_multihomed.t | 12 | ||||
-rw-r--r-- | dist/IO/t/io_pipe.t | 22 | ||||
-rw-r--r-- | dist/IO/t/io_poll.t | 2 | ||||
-rw-r--r-- | dist/IO/t/io_sel.t | 10 | ||||
-rw-r--r-- | dist/IO/t/io_sock.t | 34 | ||||
-rw-r--r-- | dist/IO/t/io_taint.t | 6 | ||||
-rw-r--r-- | dist/IO/t/io_tell.t | 11 | ||||
-rw-r--r-- | dist/IO/t/io_unix.t | 12 | ||||
-rw-r--r-- | dist/IO/t/io_utf8.t | 2 | ||||
-rw-r--r-- | dist/IO/t/io_utf8argv.t | 2 | ||||
-rw-r--r-- | dist/IO/t/io_xs.t | 4 |
18 files changed, 79 insertions, 73 deletions
diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm index eacd4c2bd6..5b637df61d 100644 --- a/dist/IO/IO.pm +++ b/dist/IO/IO.pm @@ -7,7 +7,7 @@ use Carp; use strict; use warnings; -our $VERSION = "1.43"; +our $VERSION = "1.44"; XSLoader::load 'IO', $VERSION; sub import { diff --git a/dist/IO/Makefile.PL b/dist/IO/Makefile.PL index 327bb275c5..665c0c4710 100644 --- a/dist/IO/Makefile.PL +++ b/dist/IO/Makefile.PL @@ -11,7 +11,7 @@ my $define = ""; unless ( $PERL_CORE or exists $Config{'i_poll'} ) { my @inc = split( /\s+/, join( " ", $Config{'usrinc'}, $Config{'incpth'}, $Config{'locincpth'} ) ); - foreach $path (@inc) { + foreach my $path (@inc) { if ( -f $path . "/poll.h" ) { $define .= "-DI_POLL "; last; diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index f10ac37532..ad8966dd22 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -23,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); our @ISA = qw(IO::Handle); -our $VERSION = "1.43"; +our $VERSION = "1.44"; our @EXPORT_OK = qw(sockatmark); @@ -120,7 +120,7 @@ sub connect { if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) { require IO::Select; - my $sel = new IO::Select $sock; + my $sel = IO::Select->new( $sock ); undef $!; my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout); @@ -243,7 +243,7 @@ sub accept { if(defined $timeout) { require IO::Select; - my $sel = new IO::Select $sock; + my $sel = IO::Select->new( $sock ); unless ($sel->can_read($timeout)) { $@ = 'accept: timeout'; diff --git a/dist/IO/t/io_const.t b/dist/IO/t/io_const.t index f6f83c1956..5e92172d7c 100644 --- a/dist/IO/t/io_const.t +++ b/dist/IO/t/io_const.t @@ -14,6 +14,7 @@ use IO::Handle; print "1..6\n"; my $i = 1; foreach (qw(SEEK_SET SEEK_CUR SEEK_END _IOFBF _IOLBF _IONBF)) { + no strict 'refs'; my $d1 = defined(&{"IO::Handle::" . $_}) ? 1 : 0; my $v1 = $d1 ? &{"IO::Handle::" . $_}() : undef; my $v2 = IO::Handle::constant($_); diff --git a/dist/IO/t/io_dir.t b/dist/IO/t/io_dir.t index 6c30143395..53122f3572 100644 --- a/dist/IO/t/io_dir.t +++ b/dist/IO/t/io_dir.t @@ -1,5 +1,11 @@ #!./perl +use strict; +use File::Temp qw( tempdir ); +use Cwd; + +no strict 'subs'; + BEGIN { require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); plan(16); @@ -8,10 +14,6 @@ BEGIN { IO::Dir->import(DIR_UNLINK); } -use strict; -use File::Temp qw( tempdir ); -use Cwd; - my $cwd = cwd(); { diff --git a/dist/IO/t/io_dup.t b/dist/IO/t/io_dup.t index 6afc96a272..dc5cadf4c7 100644 --- a/dist/IO/t/io_dup.t +++ b/dist/IO/t/io_dup.t @@ -21,11 +21,11 @@ print "1..6\n"; print "ok 1\n"; -$dupout = IO::Handle->new->fdopen( \*STDOUT ,"w"); -$duperr = IO::Handle->new->fdopen( \*STDERR ,"w"); +my $dupout = IO::Handle->new->fdopen( \*STDOUT ,"w"); +my $duperr = IO::Handle->new->fdopen( \*STDERR ,"w"); -$stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle"; -$stderr = \*STDERR; bless $stderr, "IO::Handle"; +my $stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle"; +my $stderr = \*STDERR; bless $stderr, "IO::Handle"; $stdout->open( "Io.dup","w") || die "Can't open stdout"; $stderr->fdopen($stdout,"w"); @@ -34,9 +34,9 @@ print $stdout "ok 2\n"; print $stderr "ok 3\n"; # Since some systems don't have echo, we use Perl. -$echo = qq{$^X -le "print q(ok %d)"}; +my $echo = qq{$^X -le "print q(ok %d)"}; -$cmd = sprintf $echo, 4; +my $cmd = sprintf $echo, 4; print `$cmd`; $cmd = sprintf "$echo 1>&2", 5; diff --git a/dist/IO/t/io_linenum.t b/dist/IO/t/io_linenum.t index 734854b928..d315c37e0e 100644 --- a/dist/IO/t/io_linenum.t +++ b/dist/IO/t/io_linenum.t @@ -7,7 +7,7 @@ my $File; BEGIN { $File = __FILE__; - require strict; import strict; + require strict; strict->import(); } use Test::More tests => 12; diff --git a/dist/IO/t/io_multihomed.t b/dist/IO/t/io_multihomed.t index f2a8e11f1c..a63d87306f 100644 --- a/dist/IO/t/io_multihomed.t +++ b/dist/IO/t/io_multihomed.t @@ -29,7 +29,7 @@ watchdog(15); package Multi; require IO::Socket::INET; -@ISA=qw(IO::Socket::INET); +our @ISA=qw(IO::Socket::INET); use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in); @@ -74,7 +74,7 @@ package main; use IO::Socket; -$listen = IO::Socket::INET->new(LocalAddr => 'localhost', +my $listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => 2, Proto => 'tcp', Timeout => 5, @@ -82,11 +82,11 @@ $listen = IO::Socket::INET->new(LocalAddr => 'localhost', print "ok 1\n"; -$port = $listen->sockport; +my $port = $listen->sockport; -if($pid = fork()) { +if (my $pid = fork()) { - $sock = $listen->accept() or die "$!"; + my $sock = $listen->accept() or die "$!"; print "ok 5\n"; print $sock->getline(); @@ -100,7 +100,7 @@ if($pid = fork()) { } elsif(defined $pid) { - $sock = Multi->new(PeerPort => $port, + my $sock = Multi->new(PeerPort => $port, Proto => 'tcp', PeerAddr => 'localhost', MultiHomed => 1, diff --git a/dist/IO/t/io_pipe.t b/dist/IO/t/io_pipe.t index e4f5f190a5..e196014bef 100644 --- a/dist/IO/t/io_pipe.t +++ b/dist/IO/t/io_pipe.t @@ -37,18 +37,20 @@ my $is_win32=$^O eq 'MSWin32' ? "MSWin32 has broken pipes" : ""; $| = 1; print "1..10\n"; +my $pipe; + if ($is_win32) { print "ok $_ # skipped: $is_win32\n" for 1..4; } else { - $pipe = new IO::Pipe->reader($perl, '-e', 'print qq(not ok 1\n)'); + $pipe = IO::Pipe->new()->reader($perl, '-e', 'print qq(not ok 1\n)'); while (<$pipe>) { s/^not //; print; } $pipe->close or print "# \$!=$!\nnot "; print "ok 2\n"; - $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //'; - $pipe = new IO::Pipe->writer($perl, '-pe', $cmd); + my $cmd = 'BEGIN{$SIG{ALRM} = sub {print qq(not ok 4\n); exit}; alarm 10} s/not //'; + $pipe = IO::Pipe->new()->writer($perl, '-pe', $cmd); print $pipe "not ok 3\n" ; $pipe->close or print "# \$!=$!\nnot "; print "ok 4\n"; @@ -61,9 +63,9 @@ if ($^O eq 'os2' and exit 0; } -$pipe = new IO::Pipe; +$pipe = IO::Pipe->new(); -$pid = fork(); +my $pid = fork(); if($pid) { @@ -76,7 +78,7 @@ if($pid) elsif(defined $pid) { $pipe->reader; - $stdin = bless \*STDIN, "IO::Handle"; + my $stdin = bless \*STDIN, "IO::Handle"; $stdin->fdopen($pipe,"r"); exec $^X, '-pne', 'tr/YX/ko/'; } @@ -88,8 +90,8 @@ else if ($is_win32) { print "ok $_ # skipped: $is_win32\n" for 7..8; } else { - $pipe = new IO::Pipe; - $pid = fork(); + $pipe = IO::Pipe->new(); + my $pid = fork(); if($pid) { @@ -105,7 +107,7 @@ if ($is_win32) { { $pipe->writer; - $stdout = bless \*STDOUT, "IO::Handle"; + my $stdout = bless \*STDOUT, "IO::Handle"; $stdout->fdopen($pipe,"w"); print STDOUT "not ok 7\n"; my @echo = 'echo'; @@ -122,7 +124,7 @@ if ($is_win32) { if ($is_win32) { print "ok $_ # skipped: $is_win32\n" for 9; } else { - $pipe = new IO::Pipe; + $pipe = IO::Pipe->new; $pipe->writer; $SIG{'PIPE'} = 'broken_pipe'; diff --git a/dist/IO/t/io_poll.t b/dist/IO/t/io_poll.t index ec32eb6ad9..0a6b228a85 100644 --- a/dist/IO/t/io_poll.t +++ b/dist/IO/t/io_poll.t @@ -8,7 +8,7 @@ print "1..12\n"; use IO::Handle; use IO::Poll qw(/POLL/); -my $poll = new IO::Poll; +my $poll = IO::Poll->new(); my $stdout = \*STDOUT; my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w"); diff --git a/dist/IO/t/io_sel.t b/dist/IO/t/io_sel.t index 34af03a3e8..80cd72aac3 100644 --- a/dist/IO/t/io_sel.t +++ b/dist/IO/t/io_sel.t @@ -7,14 +7,14 @@ print "1..27\n"; use IO::Select 1.09; -my $sel = new IO::Select(\*STDIN); +my $sel = IO::Select->new(\*STDIN); $sel->add(4, 5) == 2 or print "not "; print "ok 1\n"; $sel->add([\*STDOUT, 'foo']) == 1 or print "not "; print "ok 2\n"; -@handles = $sel->handles; +my @handles = $sel->handles; print "not " unless $sel->count == 4 && @handles == 4; print "ok 3\n"; #print $sel->as_string, "\n"; @@ -34,7 +34,7 @@ $sel->remove(1, 4); print "not " unless $sel->count == 0 && !defined($sel->bits); print "ok 7\n"; -$sel = new IO::Select; +$sel = IO::Select->new(); print "not " unless $sel->count == 0 && !defined($sel->bits); print "ok 8\n"; @@ -50,7 +50,7 @@ if ( grep $^O eq $_, qw(MSWin32 NetWare dos VMS riscos beos) ) { goto POST_SOCKET; } -@a = $sel->can_read(); # should return immediately +my @a = $sel->can_read(); # should return immediately print "not " unless @a == 0; print "ok 10\n"; @@ -70,7 +70,7 @@ $sel->add(\*STDOUT); # update print "not " unless @a == 3; print "ok 13\n"; -($r, $w, $e) = @a; +my ($r, $w, $e) = @a; print "not " unless @$r == 0 && @$w == 1 && @$e == 0; print "ok 14\n"; diff --git a/dist/IO/t/io_sock.t b/dist/IO/t/io_sock.t index c7b9557e0b..3bc5118cbc 100644 --- a/dist/IO/t/io_sock.t +++ b/dist/IO/t/io_sock.t @@ -25,7 +25,7 @@ BEGIN { } } -my $has_perlio = find PerlIO::Layer 'perlio'; +my $has_perlio = PerlIO::Layer->find( 'perlio' ); $| = 1; print "1..26\n"; @@ -37,7 +37,7 @@ eval { use IO::Socket; -$listen = IO::Socket::INET->new(LocalAddr => 'localhost', +my $listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => 2, Proto => 'tcp', # some systems seem to need as much as 10, @@ -54,11 +54,11 @@ if ($^O eq 'os2' and exit 0; } -$port = $listen->sockport; +my $port = $listen->sockport; -if($pid = fork()) { +if(my $pid = fork()) { - $sock = $listen->accept() or die "accept failed: $!"; + my $sock = $listen->accept() or die "accept failed: $!"; print "ok 2\n"; $sock->autoflush(1); @@ -74,7 +74,7 @@ if($pid = fork()) { } elsif(defined $pid) { - $sock = IO::Socket::INET->new(PeerPort => $port, + my $sock = IO::Socket::INET->new(PeerPort => $port, Proto => 'tcp', PeerAddr => 'localhost' ) @@ -102,10 +102,10 @@ if($pid = fork()) { $listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => '', Timeout => 15) or die "$!"; $port = $listen->sockport; -if($pid = fork()) { +if(my $pid = fork()) { SERVER_LOOP: while (1) { - last SERVER_LOOP unless $sock = $listen->accept; + last SERVER_LOOP unless my $sock = $listen->accept; while (<$sock>) { last SERVER_LOOP if /^quit/; last if /^done/; @@ -116,7 +116,7 @@ if($pid = fork()) { $listen->close; } elsif (defined $pid) { # child, try various ways to connect - $sock = IO::Socket::INET->new("localhost:$port") + my $sock = IO::Socket::INET->new("localhost:$port") || IO::Socket::INET->new("127.0.0.1:$port"); if ($sock) { print "not " unless $sock->connected; @@ -171,7 +171,7 @@ if($pid = fork()) { } # Then test UDP sockets -$server = IO::Socket->new(Domain => AF_INET, +my $server = IO::Socket->new(Domain => AF_INET, Proto => 'udp', LocalAddr => 'localhost') || IO::Socket->new(Domain => AF_INET, @@ -179,13 +179,13 @@ $server = IO::Socket->new(Domain => AF_INET, LocalAddr => '127.0.0.1'); $port = $server->sockport; -if ($pid = fork()) { +if (my $pid = fork()) { my $buf; $server->recv($buf, 100); print $buf; } elsif (defined($pid)) { #child - $sock = IO::Socket::INET->new(Proto => 'udp', + my $sock = IO::Socket::INET->new(Proto => 'udp', PeerAddr => "localhost:$port") || IO::Socket::INET->new(Proto => 'udp', PeerAddr => "127.0.0.1:$port"); @@ -214,7 +214,7 @@ if ( $^O eq 'qnx' ) { ### Set up some data to be transferred between the server and ### the client. We'll use own source code ... # -local @data; +my @data; if( !open( SRC, '<', $0)) { print "not ok 15 - $!\n"; } else { @@ -226,7 +226,7 @@ if( !open( SRC, '<', $0)) { ### TEST 16 ### Start the server # -my $listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => 2, Proto => 'tcp', Timeout => 15) || +$listen = IO::Socket::INET->new(LocalAddr => 'localhost', Listen => 2, Proto => 'tcp', Timeout => 15) || print "not "; print "ok 16\n"; die if( !defined( $listen)); @@ -241,7 +241,7 @@ if( $server_pid) { ### TEST 18 ### Get data from the server using a single stream # - $sock = IO::Socket::INET->new("localhost:$serverport") + my $sock = IO::Socket::INET->new("localhost:$serverport") || IO::Socket::INET->new("127.0.0.1:$serverport"); if ($sock) { @@ -343,7 +343,7 @@ if( $server_pid) { ### Child # SERVER_LOOP: while (1) { - last SERVER_LOOP unless $sock = $listen->accept; + last SERVER_LOOP unless my $sock = $listen->accept; # Do not print ok/not ok for this binmode() since there's # a race condition with our client, just die if we fail. if ($has_perlio) { binmode($sock, ":utf8") or die } @@ -383,7 +383,7 @@ if( $server_pid) { # test Blocking option in constructor -$sock = IO::Socket::INET->new(Blocking => 0) +my $sock = IO::Socket::INET->new(Blocking => 0) or print "not "; print "ok 25\n"; diff --git a/dist/IO/t/io_taint.t b/dist/IO/t/io_taint.t index 7c3ffe6881..8a599c3bcb 100644 --- a/dist/IO/t/io_taint.t +++ b/dist/IO/t/io_taint.t @@ -24,11 +24,11 @@ plan(tests => 5); END { unlink "./__taint__$$" } use IO::File; -my $x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n"); +my $x = IO::File->new( "> ./__taint__$$" ) || die("Cannot open ./__taint__$$\n"); print $x "$$\n"; $x->close; -$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n"); +$x = IO::File->new( "< ./__taint__$$" ) || die("Cannot open ./__taint__$$\n"); chop(my $unsafe = <$x>); eval { kill 0 * $unsafe }; SKIP: { @@ -39,7 +39,7 @@ $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 = IO::File->new( "< ./__taint__$$" ) || die("Cannot open ./__taint__$$\n"); $x->untaint; ok(!$?); # Calling the method worked chop($unsafe = <$x>); diff --git a/dist/IO/t/io_tell.t b/dist/IO/t/io_tell.t index 3f8ad30b9f..62a0a770eb 100644 --- a/dist/IO/t/io_tell.t +++ b/dist/IO/t/io_tell.t @@ -1,5 +1,6 @@ #!./perl +my $tell_file; BEGIN { $tell_file = "Makefile.PL"; } @@ -17,20 +18,20 @@ print "1..13\n"; use IO::File; -$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file"); +my $tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file"); binmode $tst; # its a nop unless it matters. Was only if ($^O eq 'MSWin32' or $^O eq 'dos'); if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; } -$firstline = <$tst>; -$secondpos = tell; +my $firstline = <$tst>; +my $secondpos = tell; -$x = 0; +my $x = 0; while (<$tst>) { if (eof) {$x++;} } if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; } -$lastpos = tell; +my $lastpos = tell; unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; } diff --git a/dist/IO/t/io_unix.t b/dist/IO/t/io_unix.t index 93cddfb7c6..cb442dbef3 100644 --- a/dist/IO/t/io_unix.t +++ b/dist/IO/t/io_unix.t @@ -43,7 +43,7 @@ BEGIN { } } -$PATH = "sock-$$"; +my $PATH = "sock-$$"; if ($^O eq 'os2') { # Can't create sockets with relative path... require Cwd; @@ -64,7 +64,7 @@ unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!"; $| = 1; print "1..5\n"; -$listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0); +my $listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0); # Sometimes UNIX filesystems are mounted for security reasons # with "nodev" option which spells out "no" for creating UNIX @@ -73,7 +73,7 @@ $listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0); unless (defined $listen) { eval { require File::Temp }; unless ($@) { - import File::Temp 'mktemp'; + File::Temp->import( 'mktemp' ); for my $TMPDIR ($ENV{TMPDIR}, "/tmp") { if (defined $TMPDIR && -d $TMPDIR && -w $TMPDIR) { $PATH = mktemp("$TMPDIR/sXXXXXXXX"); @@ -86,9 +86,9 @@ unless (defined $listen) { } print "ok 1\n"; -if($pid = fork()) { +if (my $pid = fork()) { - $sock = $listen->accept(); + my $sock = $listen->accept(); if (defined $sock) { print "ok 2\n"; @@ -111,7 +111,7 @@ if($pid = fork()) { } } elsif(defined $pid) { - $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!"; + my $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!"; print $sock "ok 3\n"; diff --git a/dist/IO/t/io_utf8.t b/dist/IO/t/io_utf8.t index 1125155a3e..14abc4a70e 100644 --- a/dist/IO/t/io_utf8.t +++ b/dist/IO/t/io_utf8.t @@ -1,7 +1,7 @@ #!./perl BEGIN { - unless (find PerlIO::Layer 'perlio') { + unless ( PerlIO::Layer->find('perlio') ) { print "1..0 # Skip: not perlio\n"; exit 0; } diff --git a/dist/IO/t/io_utf8argv.t b/dist/IO/t/io_utf8argv.t index b6370709f1..76095a5880 100644 --- a/dist/IO/t/io_utf8argv.t +++ b/dist/IO/t/io_utf8argv.t @@ -1,7 +1,7 @@ #!./perl BEGIN { - unless (find PerlIO::Layer 'perlio') { + unless ( PerlIO::Layer->find('perlio') ) { print "1..0 # Skip: not perlio\n"; exit 0; } diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t index f7d7258caf..1e3c49a4a7 100644 --- a/dist/IO/t/io_xs.t +++ b/dist/IO/t/io_xs.t @@ -15,7 +15,7 @@ use Test::More tests => 5; use IO::File; use IO::Seekable; -$x = new_tmpfile IO::File; +my $x = IO::File->new_tmpfile(); ok($x, "new_tmpfile"); print $x "ok 2\n"; $x->seek(0,SEEK_SET); @@ -24,7 +24,7 @@ is($line, "ok 2\n", "check we can write to the tempfile"); $x->seek(0,SEEK_SET); print $x "not ok 3\n"; -$p = $x->getpos; +my $p = $x->getpos; print $x "ok 3\n"; $x->flush; $x->setpos($p); |