summaryrefslogtreecommitdiff
path: root/dist
diff options
context:
space:
mode:
authorRicardo Signes <rjbs@cpan.org>2012-05-14 15:49:27 -0400
committerRicardo Signes <rjbs@cpan.org>2012-05-14 15:49:44 -0400
commita5bed8371aed7057b6c4cf1084b0dc96e1abe33b (patch)
tree82d619a302afddd0f620080b09f966f7520c2c64 /dist
parent29534a18a4544e864a3e980c6de7e58d871335a9 (diff)
downloadperl-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.PL3
-rw-r--r--dist/IO/lib/IO/Socket.pm11
-rw-r--r--dist/IO/t/cachepropagate-tcp.t56
-rw-r--r--dist/IO/t/cachepropagate-udp.t34
-rw-r--r--dist/IO/t/cachepropagate-unix.t88
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);
-}