[PATCH lib/vmsish.t] Small test name abuse.

From: Michael G Schwern <schwern@pobox.com>
Date: Fri, 7 Dec 2001 20:03:45 -0500
Message-ID: <20011208010345.GD642@blackrider>

Subject: [PATCH vms/test.com] Goodbye frightening echo kludge!
From: Michael G Schwern <schwern@pobox.com>
Date: Fri, 7 Dec 2001 20:13:54 -0500
Message-ID: <20011208011354.GE642@blackrider>

Subject: [PATCH t/io/pipe.t t/test.pl] Cleanup & $NO_ENDING
From: Michael G Schwern <schwern@pobox.com>
Date: Fri, 7 Dec 2001 21:47:36 -0500
Message-ID: <20011208024736.GH642@blackrider>

Subject: [PATCH t/op/exec.t] Piping and newline on pipe tests
From: Michael G Schwern <schwern@pobox.com>
Date: Fri, 7 Dec 2001 23:09:43 -0500
Message-ID: <20011208040943.GK642@blackrider>

Subject: [PATCH] vms/test.com -- skip tty tests when not interactive
Message-Id: <a05101004b83754903506@[172.16.52.1]>
Date: Fri, 7 Dec 2001 23:28:15 -0600
From: "Craig A. Berry" <craigberry@mac.com>

p4raw-id: //depot/perl@13535

1 files changed, 128 insertions, 134 deletions

diff --git a/t/io/pipe.t b/t/io/pipe.t
index 500832595e..c32f3b1046 100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -4,61 +4,84 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require Config; import Config;
-    unless ($Config{'d_fork'}) {
-	print "1..0 # Skip: no fork\n";
-	exit 0;
+    require './test.pl';
+
+    if (!$Config{'d_fork'}) {
+        skip_all("fork required to pipe");
+    }
+    else {
+        plan(tests => 22);
     }
 }
 
+my $Perl = which_perl();
+
+
 $| = 1;
-print "1..16\n";
 
-# External program 'tr' assumed.
-open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
-print PIPE "Xk 1\n";
-print PIPE "oY 2\n";
+open(PIPE, "|-") || exec $Perl, '-pe', 'tr/YX/ko/';
+
+printf PIPE "Xk %d - open |- || exec\n", curr_test();
+next_test();
+printf PIPE "oY %d -    again\n", curr_test();
+next_test();
 close PIPE;
 
-if ($^O eq 'vmesa') {
-    # Doesn't work, yet.
-    for (3..6) {
-	print "ok $_ # skipped\n";
-    }
-} else {
+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 //;
 	    print;
 	}
-	close PIPE;        # avoid zombies which disrupt test 12
+	close PIPE;        # avoid zombies
     }
     else {
-	# External program 'echo' assumed.
-	print STDOUT "not ok 3\n";
-	exec 'echo', 'not ok 4';
+	printf STDOUT "not ok %d - open -|\n", curr_test();
+        next_test();
+        my $tnum = curr_test;
+        next_test();
+	exec $Perl, '-le', "print q{not ok $tnum -     again}";
     }
 
-    pipe(READER,WRITER) || die "Can't open pipe";
-
-    if ($pid = fork) {
-	close WRITER;
-	while(<READER>) {
-	    s/^not //;
-	    y/A-Z/a-z/;
-	    print;
-	}
-	close READER;     # avoid zombies which disrupt test 12
-    }
-    else {
-	die "Couldn't fork" unless defined $pid;
-	close READER;
-	print WRITER "not ok 5\n";
-	open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT";
-	close WRITER;
-	# External program 'echo' assumed.
-	exec 'echo', 'not ok 6';
+    # This has to be *outside* the fork
+    next_test() for 1..2;
+
+    SKIP: {
+        skip "fork required", 2 unless $Config{d_fork};
+
+        pipe(READER,WRITER) || die "Can't open pipe";
+
+        if ($pid = fork) {
+            close WRITER;
+            while(<READER>) {
+                s/^not //;
+                y/A-Z/a-z/;
+                print;
+            }
+            close READER;     # avoid zombies
+        }
+        else {
+            die "Couldn't fork" unless defined $pid;
+            close READER;
+            printf WRITER "not ok %d - pipe & fork\n", curr_test;
+            next_test;
+
+            open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT";
+            close WRITER;
+            
+            my $tnum = curr_test;
+            next_test;
+            exec $Perl, '-le', "print q{not ok $tnum -     with fh dup }";
+        }
+
+        # This has to be done *outside* the fork.
+        next_test() for 1..2;
     }
-}
+} 
 wait;				# Collect from $pid
 
 pipe(READER,WRITER) || die "Can't open pipe";
@@ -68,122 +91,94 @@ $SIG{'PIPE'} = 'broken_pipe';
 
 sub broken_pipe {
     $SIG{'PIPE'} = 'IGNORE';       # loop preventer
-    print "ok 7\n";
+    printf "ok %d - SIGPIPE\n", curr_test;
 }
 
-print WRITER "not ok 7\n";
+printf WRITER "not ok %d - SIGPIPE\n", curr_test;
 close WRITER;
 sleep 1;
-print "ok 8\n";
+next_test;
+pass();
 
 # VMS doesn't like spawning subprocesses that are still connected to
-# STDOUT.  Someone should modify tests #9 to #12 to work with VMS.
-
-if ($^O eq 'VMS') {
-    print "ok 9 # skipped\n";
-    print "ok 10 # skipped\n";
-    print "ok 11 # skipped\n";
-    print "ok 12 # skipped\n";
-    exit;
-}
-
-if ($Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || $^O eq 'posix-bc') {
-    # 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.
-    print "ok 9 # skipped\n";
-}
-else {
-    local $SIG{PIPE} = 'IGNORE';
-    open NIL, '|true'	or die "open failed: $!";
-    sleep 5;
-    if (print NIL 'foo') {
-	# If print was allowed we had better get an error on close
-	if (close NIL) {
-	    print "not ok 9\n";
-	}
-	else {
-	    print "ok 9\n";
-	}
-    }
-    else {
-	# If print failed, the close should be clean
-	if (close NIL) {
-	    print "ok 9\n";
-	}
-	else {
-	    print "not ok 9\n";
-	}
+# STDOUT.  Someone should modify these tests to work with VMS.
+
+SKIP: {
+    skip "doesn't like spawning subprocesses that are still connected", 10
+      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.
+        skip "Won't report failure on broken pipe", 1
+          if $Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || 
+             $^O eq 'posix-bc';
+
+        local $SIG{PIPE} = 'IGNORE';
+        open NIL, qq{|$Perl -e "exit 0"} or die "open failed: $!";
+        sleep 5;
+        if (print NIL 'foo') {
+            # If print was allowed we had better get an error on close
+            ok( !close NIL,     'close error on broken pipe' );
+        }
+        else {
+            ok(close NIL,       'print failed on broken pipe');
+        }
     }
-}
 
-if ($^O eq 'vmesa') {
-    # These don't work, yet.
-    print "ok 10 # skipped\n";
-    print "ok 11 # skipped\n";
-    print "ok 12 # skipped\n";
-    exit;
-}
-
-# check that errno gets forced to 0 if the piped program exited non-zero
-open NIL, '|exit 23;' or die "fork failed: $!";
-$! = 1;
-if (close NIL) {
-    print "not ok 10\n# successful close\n";
-}
-elsif ($! != 0) {
-    print "not ok 10\n# errno $!\n";
-}
-elsif ($? == 0) {
-    print "not ok 10\n# status 0\n";
-}
-else {
-    print "ok 10\n";
-}
-
-if ($^O eq 'mpeix') {
-    print "ok 11 # skipped\n";
-    print "ok 12 # skipped\n";
-} else {
-    # check that status for the correct process is collected
-    my $zombie = fork or exit 37;
-    my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
-    $SIG{ALRM} = sub { return };
-    alarm(1);
-    my $close = close FH;
-    if ($? == 13*256 && ! length $close && ! $!) {
-        print "ok 11\n";
-    } else {
-        print "not ok 11\n# close $close\$?=$?   \$!=", $!+0, ":$!\n";
-    };
-    my $wait = wait;
-    if ($? == 37*256 && $wait == $zombie && ! $!) {
-        print "ok 12\n";
-    } else {
-        print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$?   \$!=", $!+0, ":$!\n";
+    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: $!";
+        $! = 1;
+        ok(!close NIL,  'close failure on non-zero piped exit');
+        is($!, '',      '       errno');
+        isnt($?, 0,     '       status');
+
+        SKIP: {
+            skip "Don't work yet", 6 if $^O eq 'mpeix';
+
+            # check that status for the correct process is collected
+            my $zombie;
+            unless( $zombie = fork ) {
+                $NO_ENDING=1;
+                exit 37;
+            }
+            my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
+            $SIG{ALRM} = sub { return };
+            alarm(1);
+            is( close FH, '',   'close failure for... umm, something' );
+            is( $?, 13*256,     '       status' );
+            is( $!, '',         '       errno');
+
+            my $wait = wait;
+            is( $?, 37*256,     'status correct after wait' );
+            is( $wait, $zombie, '       wait pid' );
+            is( $!, '',         '       errno');
+        }
     }
 }
 
 # Test new semantics for missing command in piped open
 # 19990114 M-J. Dominus mjd@plover.com
 { local *P;
-  print (((open P, "|    " ) ? "not " : ""), "ok 13\n");
-  print (((open P, "     |" ) ? "not " : ""), "ok 14\n");
+  ok( !open(P, "|    "),        'missing command in piped open input' );
+  ok( !open(P, "     |"),       '                              output');
 }
 
 # check that status is unaffected by implicit close
 {
     local(*NIL);
-    open NIL, '|exit 23;' or die "fork failed: $!";
+    open NIL, qq{|$Perl -e "exit 23"} or die "fork failed: $!";
     $? = 42;
     # NIL implicitly closed here
 }
-if ($? != 42) {
-    print "# status $?, expected 42\nnot ";
-}
-print "ok 15\n";
+is($?, 42,      'status unaffected by implicit close');
 $? = 0;
 
 # check that child is reaped if the piped program can't be executed
@@ -199,6 +194,5 @@ $? = 0;
     alarm 0;
   };
 
-  print "not " if $child != -1;
-  print "ok 16\n";
+  is($child, -1, 'child reaped if piped program cannot be executed');
 }