diff options
author | Ricardo Signes <rjbs@cpan.org> | 2012-05-14 15:49:27 -0400 |
---|---|---|
committer | Ricardo Signes <rjbs@cpan.org> | 2012-05-14 15:49:44 -0400 |
commit | a5bed8371aed7057b6c4cf1084b0dc96e1abe33b (patch) | |
tree | 82d619a302afddd0f620080b09f966f7520c2c64 /dist | |
parent | 29534a18a4544e864a3e980c6de7e58d871335a9 (diff) | |
download | perl-a5bed8371aed7057b6c4cf1084b0dc96e1abe33b.tar.gz |
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.
Diffstat (limited to 'dist')
-rw-r--r-- | dist/IO/Makefile.PL | 3 | ||||
-rw-r--r-- | dist/IO/lib/IO/Socket.pm | 11 | ||||
-rw-r--r-- | dist/IO/t/cachepropagate-tcp.t | 56 | ||||
-rw-r--r-- | dist/IO/t/cachepropagate-udp.t | 34 | ||||
-rw-r--r-- | dist/IO/t/cachepropagate-unix.t | 88 |
5 files changed, 1 insertions, 191 deletions
diff --git a/dist/IO/Makefile.PL b/dist/IO/Makefile.PL index 70ffe12acf..2159f43e49 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 <gbarr@cpan.org>', - PREREQ_PM => { - 'Test::More' => 0, - }, ( $PERL_CORE ? () : ( diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index 393f8368d1..529423b5fd 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 cec9a7ba8f..0000000000 --- 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 91cff376b2..0000000000 --- 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 1b0ace7a29..0000000000 --- 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); -} |