Put a watchdog on openpid.t: it has been found to hang in some Win32 smokes.
[p5sagit/p5-mst-13.2.git] / t / io / through.t
index d664b08..a76c64d 100644 (file)
@@ -1,6 +1,10 @@
 #!./perl
 
 BEGIN {
+    if ($^O eq 'VMS') {
+        print "1..0 # Skip on VMS -- too picky about line endings for record-oriented pipes\n";
+        exit;
+    }
     chdir 't' if -d 't';
     @INC = '../lib';
 }
@@ -34,7 +38,8 @@ $c += 6;      # Tests with sleep()...
 print "1..$c\n";
 
 my $set_out = '';
-$set_out = "binmode STDOUT, ':crlf'" if $main::use_crlf = 1;
+$set_out = "binmode STDOUT, ':crlf'"
+    if defined  $main::use_crlf && $main::use_crlf == 1;
 
 sub testread ($$$$$$$) {
   my ($fh, $str, $read_c, $how_r, $write_c, $how_w, $why) = @_;
@@ -76,7 +81,8 @@ sub testpipe ($$$$$$) {
   } else {
     die "Unrecognized write: '$how_w'";
   }
-  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  binmode $fh, ':crlf'
+      if defined $main::use_crlf && $main::use_crlf == 1;
   testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "pipe$why");
 }
 
@@ -84,9 +90,11 @@ sub testfile ($$$$$$) {
   my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
   my @data = grep length, split /(.{1,$write_c})/s, $str;
 
-  open my $fh, '>', 'io_io.tmp' or die;
+  my $filename = tempfile();
+  open my $fh, '>', $filename or die;
   select $fh;
-  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  binmode $fh, ':crlf' 
+      if defined $main::use_crlf && $main::use_crlf == 1;
   if ($how_w eq 'print') {     # AUTOFLUSH???
     $| = 0;
     print $fh $_ for @data;
@@ -99,8 +107,9 @@ sub testfile ($$$$$$) {
     die "Unrecognized write: '$how_w'";
   }
   close $fh or die "close: $!";
-  open $fh, '<', 'io_io.tmp' or die;
-  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  open $fh, '<', $filename or die;
+  binmode $fh, ':crlf'
+      if defined $main::use_crlf && $main::use_crlf == 1;
   testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why");
 }
 
@@ -109,7 +118,8 @@ open my $fh, '-|', qq[$Perl -we "eval qq(\\x24\\x7c = 1) or die; binmode STDOUT;
 ok(1, 'open pipe');
 binmode $fh, q(:crlf);
 ok(1, 'binmode');
-my (@c, $c);
+$c = undef;
+my @c;
 push @c, ord $c while $c = getc $fh;
 ok(1, 'got chars');
 is(scalar @c, 9, 'got 9 chars');
@@ -134,6 +144,4 @@ for my $s (1..2) {
   }
 }
 
-unlink 'io_io.tmp';
-
 1;