From a5bed8371aed7057b6c4cf1084b0dc96e1abe33b Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Mon, 14 May 2012 15:49:27 -0400 Subject: [PATCH] Revert fixes for [rt.cpan.org #61577] These changes introduced some test failures on AIX and other platforms, and rather than dig around for more failing platforms during the RCx period, we will revert this to reapply later when it is more tested. This reverts commit 01b71c89216c9f447494638a5d108e13c45c3863. This reverts commit b6903614db213f07401367249dc84c896eb099b7. This reverts commit 271d04eee1933df0971f54f7bf9a5ca3575e7e6a. --- AUTHORS | 1 - MANIFEST | 3 -- META.yml | 3 -- dist/IO/Makefile.PL | 3 -- dist/IO/lib/IO/Socket.pm | 11 +---- dist/IO/t/cachepropagate-tcp.t | 56 --------------------- dist/IO/t/cachepropagate-udp.t | 34 ------------- dist/IO/t/cachepropagate-unix.t | 88 --------------------------------- 8 files changed, 1 insertion(+), 198 deletions(-) delete mode 100644 dist/IO/t/cachepropagate-tcp.t delete mode 100644 dist/IO/t/cachepropagate-udp.t delete mode 100644 dist/IO/t/cachepropagate-unix.t diff --git a/AUTHORS b/AUTHORS index 1547be2d51ad..88342aa283e2 100644 --- a/AUTHORS +++ b/AUTHORS @@ -250,7 +250,6 @@ Daniel Chetlin Daniel Dragan Daniel Frederick Crisman Daniel Grisinger -Daniel Kahn Gillmor Daniel Lieberman Daniel Muiño Daniel P. Berrange diff --git a/MANIFEST b/MANIFEST index 71c0d356a04a..04e8fca5ad6b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3259,9 +3259,6 @@ dist/IO/Makefile.PL IO extension makefile writer dist/IO/poll.c IO poll() emulation using select() dist/IO/poll.h IO poll() emulation using select() dist/IO/README IO extension maintenance notice -dist/IO/t/cachepropagate-tcp.t See if IO::Socket duplication works -dist/IO/t/cachepropagate-udp.t See if IO::Socket duplication works -dist/IO/t/cachepropagate-unix.t See if IO::Socket duplication works dist/IO/t/io_const.t See if constants from IO work dist/IO/t/io_dir.t See if directory-related methods from IO work dist/IO/t/io_dup.t See if dup()-related methods from IO work diff --git a/META.yml b/META.yml index ed5a5ac3146d..3f7100115cd2 100644 --- a/META.yml +++ b/META.yml @@ -78,9 +78,6 @@ no_index: - dist/IO/poll.c - dist/IO/poll.h - dist/IO/README - - dist/IO/t/cachepropagate-tcp.t - - dist/IO/t/cachepropagate-udp.t - - dist/IO/t/cachepropagate-unix.t - dist/IO/t/IO.t - dist/IO/t/io_const.t - dist/IO/t/io_dir.t diff --git a/dist/IO/Makefile.PL b/dist/IO/Makefile.PL index 70ffe12acf48..2159f43e49e0 100644 --- a/dist/IO/Makefile.PL +++ b/dist/IO/Makefile.PL @@ -33,9 +33,6 @@ WriteMakefile( OBJECT => '$(O_FILES)', ABSTRACT => 'Perl core IO modules', AUTHOR => 'Graham Barr ', - PREREQ_PM => { - 'Test::More' => 0, - }, ( $PERL_CORE ? () : ( diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index 393f8368d185..529423b5fde0 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -24,7 +24,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); @ISA = qw(IO::Handle); -$VERSION = "1.35"; +$VERSION = "1.34"; @EXPORT_OK = qw(sockatmark); @@ -349,27 +349,18 @@ sub timeout { sub sockdomain { @_ == 1 or croak 'usage: $sock->sockdomain()'; my $sock = shift; - if (!defined(${*$sock}{'io_socket_domain'})) { - my $addr = $sock->sockname(); - ${*$sock}{'io_socket_domain'} = sockaddr_family($addr) - if (defined($addr)); - } ${*$sock}{'io_socket_domain'}; } sub socktype { @_ == 1 or croak 'usage: $sock->socktype()'; my $sock = shift; - ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE) - if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE})); ${*$sock}{'io_socket_type'} } sub protocol { @_ == 1 or croak 'usage: $sock->protocol()'; my($sock) = @_; - ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL) - if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL})); ${*$sock}{'io_socket_proto'}; } diff --git a/dist/IO/t/cachepropagate-tcp.t b/dist/IO/t/cachepropagate-tcp.t deleted file mode 100644 index cec9a7ba8f81..000000000000 --- a/dist/IO/t/cachepropagate-tcp.t +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/perl - -use warnings; -use strict; - -use IO::Socket; -use IO::Socket::INET; -use Socket; -use Config; -use Test::More; - -plan tests => 8; - -my $listener = IO::Socket::INET->new(Listen => 1, - LocalAddr => '127.0.0.1', - Proto => 'tcp'); -ok(defined($listener), 'socket created'); - -my $port = $listener->sockport(); - -my $p = $listener->protocol(); -ok(defined($p), 'protocol defined'); -my $d = $listener->sockdomain(); -ok(defined($d), 'domain defined'); -my $s = $listener->socktype(); -ok(defined($s), 'type defined'); - -SKIP: { - $Config{d_pseudofork} || $Config{d_fork} - or skip("no fork", 4); - my $cpid = fork(); - if (0 == $cpid) { - # the child: - sleep(1); - my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1', - PeerPort => $port, - Proto => 'tcp'); - exit(0); - } else {; - ok(defined($cpid), 'spawned a child'); - } - - my $new = $listener->accept(); - - is($new->sockdomain(), $d, 'domain match'); - SKIP: { - skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL }); - is($new->protocol(), $p, 'protocol match'); - } - SKIP: { - skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE }); - is($new->socktype(), $s, 'type match'); - } - - wait(); -} diff --git a/dist/IO/t/cachepropagate-udp.t b/dist/IO/t/cachepropagate-udp.t deleted file mode 100644 index 91cff376b281..000000000000 --- a/dist/IO/t/cachepropagate-udp.t +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl - -use warnings; -use strict; - -use IO::Socket; -use IO::Socket::INET; -use Socket; -use Test::More; - -plan tests => 7; - -my $listener = IO::Socket::INET->new(LocalAddr => '127.0.0.1', - Proto => 'udp'); -ok(defined($listener), 'socket created'); - -my $p = $listener->protocol(); -ok(defined($p), 'protocol defined'); -my $d = $listener->sockdomain(); -ok(defined($d), 'domain defined'); -my $s = $listener->socktype(); -ok(defined($s), 'type defined'); - -my $new = IO::Socket::INET->new_from_fd($listener->fileno(), 'r+'); - -is($new->sockdomain(), $d, 'domain match'); -SKIP: { - skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL }); - is($new->protocol(), $p, 'protocol match'); -} -SKIP: { - skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE }); - is($new->socktype(), $s, 'type match'); -} diff --git a/dist/IO/t/cachepropagate-unix.t b/dist/IO/t/cachepropagate-unix.t deleted file mode 100644 index 1b0ace7a2982..000000000000 --- a/dist/IO/t/cachepropagate-unix.t +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl - -use warnings; -use strict; - -use File::Temp qw(tempdir); -use File::Spec::Functions; -use IO::Socket; -use IO::Socket::UNIX; -use Socket; -use Config; -use Test::More; - -plan tests => 15; - -SKIP: { - skip "UNIX domain sockets not implemented on $^O", 15 if ($^O =~ m/^(?:qnx|nto|vos|MSWin32)$/); - - my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock'); - - # start testing stream sockets: - - my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM, - Listen => 1, - Local => $socketpath); - ok(defined($listener), 'stream socket created'); - - my $p = $listener->protocol(); - ok(defined($p), 'protocol defined'); - my $d = $listener->sockdomain(); - ok(defined($d), 'domain defined'); - my $s = $listener->socktype(); - ok(defined($s), 'type defined'); - - SKIP: { - $Config{d_pseudofork} || $Config{d_fork} - or skip("no fork", 4); - my $cpid = fork(); - if (0 == $cpid) { - # the child: - sleep(1); - my $connector = IO::Socket::UNIX->new(Peer => $socketpath); - exit(0); - } else { - ok(defined($cpid), 'spawned a child'); - } - - my $new = $listener->accept(); - - is($new->sockdomain(), $d, 'domain match'); - SKIP: { - skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL }); - is($new->protocol(), $p, 'protocol match'); - } - SKIP: { - skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE }); - is($new->socktype(), $s, 'type match'); - } - - unlink($socketpath); - wait(); - } - - # now test datagram sockets: - $listener = IO::Socket::UNIX->new(Type => SOCK_DGRAM, - Local => $socketpath); - ok(defined($listener), 'datagram socket created'); - - $p = $listener->protocol(); - ok(defined($p), 'protocol defined'); - $d = $listener->sockdomain(); - ok(defined($d), 'domain defined'); - $s = $listener->socktype(); - ok(defined($s), 'type defined'); - - my $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+'); - - is($new->sockdomain(), $d, 'domain match'); - SKIP: { - skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL }); - is($new->protocol(), $p, 'protocol match'); - } - SKIP: { - skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE }); - is($new->socktype(), $s, 'type match'); - } - unlink($socketpath); -}