sometimes fork() isn't available
authorTony Cook <tony@develop-help.com>
Wed, 9 May 2012 18:04:28 +0000 (19:04 +0100)
committerRicardo Signes <rjbs@cpan.org>
Thu, 10 May 2012 13:53:14 +0000 (09:53 -0400)
This was amended from the original Tony prepared in a parallel branch

dist/IO/t/cachepropagate-tcp.t
dist/IO/t/cachepropagate-unix.t

index 9c26b45..cec9a7b 100644 (file)
@@ -6,6 +6,7 @@ use strict;
 use IO::Socket;
 use IO::Socket::INET;
 use Socket;
+use Config;
 use Test::More;
 
 plan tests => 8;
@@ -24,28 +25,32 @@ ok(defined($d), 'domain defined');
 my $s = $listener->socktype();
 ok(defined($s), 'type defined');
 
-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');
+  $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();
 }
-SKIP: {
-    skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
-    is($new->socktype(), $s, 'type match');
-}
-
-wait();
index 375f28a..1b0ace7 100644 (file)
@@ -8,29 +8,33 @@ 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)$/);
+  skip "UNIX domain sockets not implemented on $^O", 15 if ($^O =~ m/^(?:qnx|nto|vos|MSWin32)$/);
 
-    my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock');
+  my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock');
 
-    # start testing stream sockets:
+  # start testing stream sockets:
 
-    my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM,
-                                        Listen => 1,
-                                        Local => $socketpath);
-    ok(defined($listener), 'stream socket created');
+  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');
+  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:
@@ -44,40 +48,41 @@ SKIP: {
     my $new = $listener->accept();
 
     is($new->sockdomain(), $d, 'domain match');
-  SKIP: {
+    SKIP: {
       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
       is($new->protocol(), $p, 'protocol match');
     }
-  SKIP: {
+    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');
+  # 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');
+  $p = $listener->protocol();
+  ok(defined($p), 'protocol defined');
+  $d = $listener->sockdomain();
+  ok(defined($d), 'domain defined');
+  $s = $listener->socktype();
+  ok(defined($s), 'type defined');
 
-    $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+');
+  my $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+');
 
-    is($new->sockdomain(), $d, 'domain match');
+  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 "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);
+    skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
+    is($new->socktype(), $s, 'type match');
   }
+  unlink($socketpath);
+}