Update to IO-1.23

p4raw-id: //depot/perl@27609

diff --git a/ext/IO/ChangeLog b/ext/IO/ChangeLog
index c9f71e7..0dcb9df 100644 (file)
--- a/ext/IO/ChangeLog
+++ b/ext/IO/ChangeLog
@@ -1,3 +1,15 @@
+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
+ * Reduce number of calls to getpeername
+ * Call qualify on format name passed to format_write. Bug reported by Johan Vromans
+ * Reduce calls to getprotobyname/number. Patch from Gisle Aas
+ * Remove references to file TEST used in core so appropriate tests are skipped
+   during an install from CPAN
+ * Add method say to IO::Handle
+ * Performance improvement for IO::File::open
+ * Don't warn about a directory being closed in the DESTROY
+
 IO 1.22 -- Mon Sep  5 10:29:35 CDT 2005
 
  * Update with changes made in perl core distribution

diff --git a/ext/IO/IO.pm b/ext/IO/IO.pm
index 9fccc3a..c8d06bd 100644 (file)
--- a/ext/IO/IO.pm
+++ b/ext/IO/IO.pm
@@ -7,7 +7,7 @@ use Carp;
 use strict;
 use warnings;
 
-our $VERSION = "1.22";
+our $VERSION = "1.23";
 XSLoader::load 'IO', $VERSION;
 
 sub import {

diff --git a/ext/IO/lib/IO/Dir.pm b/ext/IO/lib/IO/Dir.pm
index e8d5fab..06892f5 100644 (file)
--- 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.05";
+$VERSION = "1.06";
 $VERSION = eval $VERSION;
 @EXPORT_OK = qw(DIR_UNLINK);
 

diff --git a/ext/IO/lib/IO/File.pm b/ext/IO/lib/IO/File.pm
index 03dab1d..d33d090 100644 (file)
--- a/ext/IO/lib/IO/File.pm
+++ b/ext/IO/lib/IO/File.pm
@@ -137,7 +137,7 @@ require Exporter;
 
 @ISA = qw(IO::Handle IO::Seekable Exporter);
 
-$VERSION = "1.13_01";
+$VERSION = "1.14";
 
 @EXPORT = @IO::Seekable::EXPORT;
 

diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm
index 86df089..e47ae87 100644 (file)
--- a/ext/IO/lib/IO/Handle.pm
+++ b/ext/IO/lib/IO/Handle.pm
@@ -265,7 +265,7 @@ use IO ();  # Load the XS module
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = "1.26";
+$VERSION = "1.27";
 $VERSION = eval $VERSION;
 
 @EXPORT_OK = qw(
@@ -579,7 +579,7 @@ sub format_write {
     @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
     if (@_ == 2) {
        my ($io, $fmt) = @_;
-       my $oldfmt = $io->format_name($fmt);
+       my $oldfmt = $io->format_name(qualify($fmt,caller));
        CORE::write($io);
        $io->format_name($oldfmt);
     } else {

diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 7e57bad..1d7437b 100644 (file)
--- 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.29_01";
+$VERSION = "1.30";
 
 @EXPORT_OK = qw(sockatmark);
 

diff --git a/ext/IO/lib/IO/Socket/INET.pm b/ext/IO/lib/IO/Socket/INET.pm
index a50b11c..f8bb338 100644 (file)
--- a/ext/IO/lib/IO/Socket/INET.pm
+++ b/ext/IO/lib/IO/Socket/INET.pm
@@ -9,12 +9,13 @@ package IO::Socket::INET;
 use strict;
 our(@ISA, $VERSION);
 use IO::Socket;
+use Socket;
 use Carp;
 use Exporter;
 use Errno;
 
 @ISA = qw(IO::Socket);
-$VERSION = "1.29_02";
+$VERSION = "1.31";
 
 my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
 

diff --git a/ext/IO/lib/IO/Socket/UNIX.pm b/ext/IO/lib/IO/Socket/UNIX.pm
index 7f5b27d..baa092b 100644 (file)
--- a/ext/IO/lib/IO/Socket/UNIX.pm
+++ b/ext/IO/lib/IO/Socket/UNIX.pm
@@ -12,7 +12,7 @@ use IO::Socket;
 use Carp;
 
 @ISA = qw(IO::Socket);
-$VERSION = "1.22_01";
+$VERSION = "1.23";
 $VERSION = eval $VERSION;
 
 IO::Socket::UNIX->register_domain( AF_UNIX );

diff --git a/ext/IO/t/io_multihomed.t b/ext/IO/t/io_multihomed.t
index 62f25bc..3c8c4a6 100644 (file)
--- a/ext/IO/t/io_multihomed.t
+++ b/ext/IO/t/io_multihomed.t
@@ -10,21 +10,19 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
-           $reason = 'Socket extension unavailable';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+       $reason = 'Socket extension unavailable';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+       $reason = 'IO extension unavailable';
+    }
+    elsif (! $Config{'d_fork'}) {
+       $reason = 'no fork';
+    }
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
     }
 }
 

diff --git a/ext/IO/t/io_pipe.t b/ext/IO/t/io_pipe.t
index 1c3ab80..7a45a7c 100755 (executable)
--- a/ext/IO/t/io_pipe.t
+++ b/ext/IO/t/io_pipe.t
@@ -16,18 +16,16 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+       $reason = 'IO extension unavailable';
+    }
+    elsif (! $Config{'d_fork'}) {
+       $reason = 'no fork';
+    }
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
     }
 }
 

diff --git a/ext/IO/t/io_sock.t b/ext/IO/t/io_sock.t
index 70a42e9..c7a7ccf 100755 (executable)
--- a/ext/IO/t/io_sock.t
+++ b/ext/IO/t/io_sock.t
@@ -10,21 +10,19 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if (-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
-           $reason = 'Socket extension unavailable';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+       $reason = 'Socket extension unavailable';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+       $reason = 'IO extension unavailable';
+    }
+    elsif (! $Config{'d_fork'}) {
+       $reason = 'no fork';
+    }
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
     }
 }
 

diff --git a/ext/IO/t/io_taint.t b/ext/IO/t/io_taint.t
index c98d701..4a9b76e 100755 (executable)
--- a/ext/IO/t/io_taint.t
+++ b/ext/IO/t/io_taint.t
@@ -10,11 +10,9 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if(-d "lib" && -f "TEST") {
-        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-           print "1..0\n";
-           exit 0;
-        }
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+       print "1..0\n";
+       exit 0;
     }
 }
 

diff --git a/ext/IO/t/io_tell.t b/ext/IO/t/io_tell.t
index 65c63bd..bdf225d 100755 (executable)
--- a/ext/IO/t/io_tell.t
+++ b/ext/IO/t/io_tell.t
@@ -14,11 +14,9 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if(-d "lib" && -f "TEST") {
-        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
-           print "1..0\n";
-           exit 0;
-        }
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+       print "1..0\n";
+       exit 0;
     }
 }
 

diff --git a/ext/IO/t/io_udp.t b/ext/IO/t/io_udp.t
index d63a5dc..641e409 100755 (executable)
--- a/ext/IO/t/io_udp.t
+++ b/ext/IO/t/io_udp.t
@@ -10,23 +10,21 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
+    my $reason;
 
-       if ($Config{'extensions'} !~ /\bSocket\b/) {
-         $reason = 'Socket was not built';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-         $reason = 'IO was not built';
-       }
-       elsif ($^O eq 'apollo') {
-         $reason = "unknown *FIXME*";
-       }
-       undef $reason if $^O eq 'VMS' and $Config{d_socket};
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-       }
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+      $reason = 'Socket was not built';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+      $reason = 'IO was not built';
+    }
+    elsif ($^O eq 'apollo') {
+      $reason = "unknown *FIXME*";
+    }
+    undef $reason if $^O eq 'VMS' and $Config{d_socket};
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
     }
 }
 

diff --git a/ext/IO/t/io_unix.t b/ext/IO/t/io_unix.t
index e0a742f..4eaf843 100644 (file)
--- a/ext/IO/t/io_unix.t
+++ b/ext/IO/t/io_unix.t
@@ -10,30 +10,29 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if(-d "lib" && -f "TEST") {
-       my $reason;
-       if (! $Config{'d_fork'}) {
-           $reason = 'no fork';
-       }
-       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
-           $reason = 'Socket extension unavailable';
-       }
-       elsif ($Config{'extensions'} !~ /\bIO\b/) {
-           $reason = 'IO extension unavailable';
-       }
-       elsif ($^O eq 'os2') {
-           require IO::Socket;
-
-           eval {IO::Socket::pack_sockaddr_un('/foo/bar') || 1}
-             or $@ !~ /not implemented/ or
-               $reason = 'compiled without TCP/IP stack v4';
-       } elsif ($^O =~ m/^(?:qnx|nto|vos)$/ ) {
-           $reason = 'Not implemented';
-       }
-       if ($reason) {
-           print "1..0 # Skip: $reason\n";
-           exit 0;
-        }
+    my $reason;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
+       $reason = 'Socket extension unavailable';
+    }
+    elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
+       $reason = 'IO extension unavailable';
+    }
+    elsif ($^O eq 'os2') {
+       require IO::Socket;
+
+       eval {IO::Socket::pack_sockaddr_un('/foo/bar') || 1}
+         or $@ !~ /not implemented/ or
+           $reason = 'compiled without TCP/IP stack v4';
+    }
+    elsif ($^O =~ m/^(?:qnx|nto|vos)$/ ) {
+       $reason = 'Not implemented';
+    }
+    elsif (! $Config{'d_fork'}) {
+       $reason = 'no fork';
+    }
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
     }
 }