X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FSocket%2Fsocketpair.t;h=fea1cb53abe49167e9b23bf18bbe9499711f4ead;hb=c0bb2de79803fbbfe9a5966d43509add0c8bb4de;hp=d70f1642c463c93b367de5e2a740175338e29fcb;hpb=b018c34d003835b4efd8ed9f28ccc297d56b7ca7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/Socket/socketpair.t b/ext/Socket/socketpair.t
index d70f164..fea1cb5 100644
--- a/ext/Socket/socketpair.t
+++ b/ext/Socket/socketpair.t
@@ -2,6 +2,7 @@
 
 my $child;
 my $can_fork;
+my $has_perlio;
 
 BEGIN {
     chdir 't' if -d 't';
@@ -32,7 +33,7 @@ BEGIN {
         $SIG{INT} = sub {exit 0}; # You have 60 seconds. Your time starts now.
         my $must_finish_by = time + 60;
         my $remaining;
-        while ($remaining = time - $must_finish_by) {
+        while (($remaining = $must_finish_by - time) > 0) {
           sleep $remaining;
         }
         warn "Something unexpectedly hung during testing";
@@ -40,6 +41,11 @@ BEGIN {
         exit 1;
       }
     }
+    unless ($has_perlio = find PerlIO::Layer 'perlio') {
+	print <<EOF;
+# Since you don't have perlio you might get failures with UTF-8 locales.
+EOF
+    }
 }
 
 use Socket;
@@ -57,7 +63,8 @@ if( !$Config{d_alarm} ) {
 } else {
   # This should fail but not die if there is real socketpair
   eval {socketpair LEFT, RIGHT, -1, -1, -1};
-  if ($@ =~ /^Unsupported socket function "socketpair" called/) {
+  if ($@ =~ /^Unsupported socket function "socketpair" called/ ||
+      $! =~ /^The operation requested is not supported./) { # Stratus VOS
     plan skip_all => 'No socketpair (real or emulated)';
   } else {
     eval {AF_UNIX};
@@ -76,8 +83,10 @@ ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC),
     "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)")
   or print "# \$\! = $!\n";
 
-binmode(LEFT,  ":bytes");
-binmode(RIGHT, ":bytes");
+if ($has_perlio) {
+    binmode(LEFT,  ":bytes");
+    binmode(RIGHT, ":bytes");
+}
 
 my @left = ("hello ", "world\n");
 my @right = ("perl ", "rules!"); # Not like I'm trying to bias any survey here.
@@ -108,7 +117,7 @@ ok (shutdown(LEFT, SHUT_WR), "shutdown left for writing");
 {
   local $SIG{ALRM} = sub { warn "EOF on right took over 3 seconds" };
   local $TODO = "Known problems with unix sockets on $^O"
-      if $^O eq 'hpux' || $^O eq 'unicosmk';
+      if $^O eq 'hpux' || $^O eq 'super-ux' || $^O eq 'unicosmk';
   alarm 3;
   $! = 0;
   ok (eof RIGHT, "right is at EOF");
@@ -165,8 +174,10 @@ ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC),
     "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)")
   or print "# \$\! = $!\n";
 
-binmode(LEFT,  ":bytes");
-binmode(RIGHT, ":bytes");
+if ($has_perlio) {
+    binmode(LEFT,  ":bytes");
+    binmode(RIGHT, ":bytes");
+}
 
 foreach (@left) {
   # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left");