This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Uninitialized tmbuf.
[perl5.git] / t / io / pipe.t
old mode 100755 (executable)
new mode 100644 (file)
index d411719..fdd8b99
@@ -10,7 +10,7 @@ BEGIN {
         skip_all("fork required to pipe");
     }
     else {
-        plan(tests => 22);
+        plan(tests => 24);
     }
 }
 
@@ -27,11 +27,7 @@ printf PIPE "oY %d -    again\n", curr_test();
 next_test();
 close PIPE;
 
-SKIP: {
-    # Technically this should be TODO.  Someone try it if you happen to
-    # have a vmesa machine.
-    skip "Doesn't work here yet", 4 if $^O eq 'vmesa';
-
+{
     if (open(PIPE, "-|")) {
        while(<PIPE>) {
            s/^not //;
@@ -50,6 +46,49 @@ SKIP: {
     # This has to be *outside* the fork
     next_test() for 1..2;
 
+    my $raw = "abc\nrst\rxyz\r\nfoo\n";
+    if (open(PIPE, "-|")) {
+       $_ = join '', <PIPE>;
+       (my $raw1 = $_) =~ s/not ok \d+ - //;
+       my @r  = map ord, split //, $raw;
+       my @r1 = map ord, split //, $raw1;
+        if ($raw1 eq $raw) {
+           s/^not (ok \d+ -) .*/$1 '@r1' passes through '-|'\n/s;
+       } else {
+           s/^(not ok \d+ -) .*/$1 expect '@r', got '@r1'\n/s;
+       }
+       print;
+       close PIPE;        # avoid zombies
+    }
+    else {
+       printf STDOUT "not ok %d - $raw", curr_test();
+        exec $Perl, '-e0';     # Do not run END()...
+    }
+
+    # This has to be *outside* the fork
+    next_test();
+
+    if (open(PIPE, "|-")) {
+       printf PIPE "not ok %d - $raw", curr_test();
+       close PIPE;        # avoid zombies
+    }
+    else {
+       $_ = join '', <STDIN>;
+       (my $raw1 = $_) =~ s/not ok \d+ - //;
+       my @r  = map ord, split //, $raw;
+       my @r1 = map ord, split //, $raw1;
+        if ($raw1 eq $raw) {
+           s/^not (ok \d+ -) .*/$1 '@r1' passes through '|-'\n/s;
+       } else {
+           s/^(not ok \d+ -) .*/$1 expect '@r', got '@r1'\n/s;
+       }
+       print;
+        exec $Perl, '-e0';     # Do not run END()...
+    }
+
+    # This has to be *outside* the fork
+    next_test();
+
     SKIP: {
         skip "fork required", 2 unless $Config{d_fork};
 
@@ -108,14 +147,10 @@ SKIP: {
       if $^O eq 'VMS';
 
     SKIP: {
-        # Sfio doesn't report failure when closing a broken pipe
-        # that has pending output.  Go figure.  MachTen doesn't either,
-        # but won't write to broken pipes, so nothing's pending at close.
-        # BeOS will not write to broken pipes, either.
-        # Nor does POSIX-BC.
+        # POSIX-BC doesn't report failure when closing a broken pipe
+        # that has pending output.  Go figure.
         skip "Won't report failure on broken pipe", 1
-          if $Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || 
-             $^O eq 'posix-bc';
+          if $^O eq 'posix-bc';
 
         local $SIG{PIPE} = 'IGNORE';
         open NIL, qq{|$Perl -e "exit 0"} or die "open failed: $!";
@@ -129,9 +164,7 @@ SKIP: {
         }
     }
 
-    SKIP: {
-        skip "Don't work yet", 9 if $^O eq 'vmesa';
-
+    {
         # check that errno gets forced to 0 if the piped program exited 
         # non-zero
         open NIL, qq{|$Perl -e "exit 23";} or die "fork failed: $!";
@@ -140,9 +173,8 @@ SKIP: {
         is($!, '',      '       errno');
         isnt($?, 0,     '       status');
 
-        SKIP: {
-            skip "Don't work yet", 6 if $^O eq 'mpeix';
-
+       # Former skip block:
+        {
             # check that status for the correct process is collected
             my $zombie;
             unless( $zombie = fork ) {