From: Michael G. Schwern <schwern@pobox.com>
Date: Thu, 6 Dec 2001 15:15:28 +0000 (-0500)
Subject: [PATCH t/base/lex.t, term.t] Purging echo from base tests
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ad20d923779746662bb01e56a1dd24d2ecb02dc2;p=p5sagit%2Fp5-mst-13.2.git

[PATCH t/base/lex.t, term.t] Purging echo from base tests
Date: Thu, 6 Dec 2001 15:15:28 -0500
Message-ID: <20011206201528.GF16414@blackrider>

(just the term.t, not the lex.t)

Subject: [PATCH t/comp/script.t] Elimininating needless logic, runs from t/ now
From: Michael G Schwern <schwern@pobox.com>
Date: Thu, 6 Dec 2001 15:22:22 -0500
Message-ID: <20011206202222.GG16414@blackrider>

Subject: [PATCH t/run/kill_perl.t] Eliminationg needless $^X logic
From: Michael G Schwern <schwern@pobox.com>
Date: Thu, 6 Dec 2001 15:31:58 -0500
Message-ID: <20011206203158.GI16414@blackrider>

Subject: [PATCH t/io/open.t t/test.pl] Cleanup and echo purge
From: Michael G Schwern <schwern@pobox.com>
Date: Thu, 6 Dec 2001 17:38:55 -0500
Message-ID: <20011206223855.GC22648@blackrider>

p4raw-id: //depot/perl@13503
---

diff --git a/t/base/term.t b/t/base/term.t
index 000bff1..2d3fe5a 100755
--- a/t/base/term.t
+++ b/t/base/term.t
@@ -19,7 +19,7 @@ else {print "not ok 1\n";}
 
 # check `` processing
 
-$x = `echo hi there`;
+$x = `$^X -le "print 'hi there'"`;
 if ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
 # check $#array
diff --git a/t/comp/script.t b/t/comp/script.t
index 4891f5b..f925b59 100755
--- a/t/comp/script.t
+++ b/t/comp/script.t
@@ -1,13 +1,8 @@
 #!./perl
 
-# $RCSfile: script.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:23 $
-
 print "1..3\n";
 
-$PERL = ($^O eq 'MSWin32') ? '.\perl'
-        : (($^O eq 'NetWare') ? 'perl'
-           : ($^O eq 'MacOS') ? $^X : './perl');
-$x = `$PERL -le "print 'ok';"`;
+$x = `$^X -le "print 'ok';"`;
 
 if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
 
@@ -15,11 +10,11 @@ open(try,">Comp.script") || (die "Can't open temp file.");
 print try 'print "ok\n";'; print try "\n";
 close try;
 
-$x = `$PERL Comp.script`;
+$x = `$^X Comp.script`;
 
 if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
-$x = `$PERL <Comp.script`;
+$x = `$^X <Comp.script`;
 
 if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
 
diff --git a/t/io/open.t b/t/io/open.t
index 9b37db3..92e71ea 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -3,304 +3,228 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-# $RCSfile$
 $|  = 1;
 use warnings;
 $Is_VMS = $^O eq 'VMS';
-$Is_Dos = $^O eq 'dos';
 
-print "1..70\n";
+plan tests => 95;
 
-my $test = 1;
-
-sub ok { print "ok $test\n"; $test++ }
-
-# my $file tests
-
-# 1..9
 {
     unlink("afile") if -f "afile";
-    print "$!\nnot " unless open(my $f,"+>afile");
-    ok;
+
+    $! = 0;  # the -f above will set $! if 'afile' doesn't exist.
+    ok( open(my $f,"+>afile"),  'open(my $f, "+>...")' );
+
     binmode $f;
-    print "not " unless -f "afile";
-    ok;
-    print "not " unless print $f "SomeData\n";
-    ok;
-    print "not " unless tell($f) == 9;
-    ok;
-    print "not " unless seek($f,0,0);
-    ok;
+    ok( -f "afile",             '       its a file');
+    ok( (print $f "SomeData\n"),  '       we can print to it');
+    is( tell($f), 9,            '       tell()' );
+    ok( seek($f,0,0),           '       seek set' );
+
     $b = <$f>;
-    print "not " unless $b eq "SomeData\n";
-    ok;
-    print "not " unless -f $f;
-    ok;
+    is( $b, "SomeData\n",       '       readline' );
+    ok( -f $f,                  '       still a file' );
+
     eval  { die "Message" };
-    # warn $@;
-    print "not " unless $@ =~ /<\$f> line 1/;
-    ok;
-    print "not " unless close($f);
-    ok;
-    unlink("afile");
+    like( $@, qr/<\$f> line 1/, '       die message correct' );
+    
+    ok( close($f),              '       close()' );
+    ok( unlink("afile"),        '       unlink()' );
 }
 
-# 10..12
 {
-    print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' < 10;
-    ok;
+    ok( open(my $f,'>', 'afile'),       "open(my \$f, '>', 'afile')" );
+    ok( (print $f "a row\n"),           '       print');
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' < 10,                '       -s' );
 }
 
-# 13..15
 {
-    print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 10;
-    ok;
+    ok( open(my $f,'>>', 'afile'),      "open(my \$f, '>>', 'afile')" );
+    ok( (print $f "a row\n"),           '       print' );
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' > 10,                '       -s'    );
 }
 
-# 16..18
 {
-    print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
+    ok( open(my $f, '<', 'afile'),      "open(my \$f, '<', 'afile')" );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline, list context' );
+    is( $rows[0], "a row\n",            '       first line read' );
+    is( $rows[1], "a row\n",            '       second line' );
+    ok( close($f),                      '       close' );
 }
 
-# 19..23
 {
-    print "not " unless -s 'afile' < 20;
-    ok;
-    print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    seek $f, 0, 1;
-    print $f "yet another row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 20;
-    ok;
+    ok( -s 'afile' < 20,                '-s' );
+
+    ok( open(my $f, '+<', 'afile'),     'open +<' );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline, list context' );
+    ok( seek($f, 0, 1),                 '       seek cur' );
+    ok( (print $f "yet another row\n"), '       print' );
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' > 20,                '       -s' );
 
     unlink("afile");
 }
 
-# 24..26
-if ($Is_VMS) {
-    for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
-}
-else {
-    print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
-    ./perl -e "print qq(a row\n); print qq(another row\n)"
+SKIP: {
+    skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
+
+    ok( open(my $f, '-|', <<EOC),     'open -|' );
+    $^X -e "print qq(a row\n); print qq(another row\n)"
 EOC
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
-}
 
-# 27..30
-if ($Is_VMS) {
-    for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline, list context' );
+    ok( close($f),                      '       close' );
 }
-else {
-    print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
-    ./perl -pe "s/^not //"
+
+{
+    ok( open(my $f, '|-', <<EOC),     'open |-' );
+    $^X -pe "s/^not //"
 EOC
-    ok;
-    @rows = <$f>;
-    print $f "not ok $test\n"; $test++;
-    print $f "not ok $test\n"; $test++;
-    print "#\nnot " unless close($f);
+
+    my @rows = <$f>;
+    my $test = curr_test;
+    print $f "not ok $test - piped in\n";
+    next_test;
+
+    $test = curr_test;
+    print $f "not ok $test - piped in\n";
+    next_test;
+    ok( close($f),                      '       close' );
     sleep 1;
-    ok;
+    pass('flushing');
 }
 
-# 31..32
-eval <<'EOE' and print "not ";
-open my $f, '<&', 'afile';
-1;
-EOE
-ok;
-$@ =~ /Bad filehandle:\s+afile/ or print "not ";
-ok;
 
-# local $file tests
+ok( !eval { open my $f, '<&', 'afile'; 1; },    '<& on a non-filehandle' );
+like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
 
-# 33..41
+
+# local $file tests
 {
     unlink("afile") if -f "afile";
-    print "$!\nnot " unless open(local $f,"+>afile");
-    ok;
+
+    ok( open(local $f,"+>afile"),       'open local $f, "+>", ...' );
     binmode $f;
-    print "not " unless -f "afile";
-    ok;
-    print "not " unless print $f "SomeData\n";
-    ok;
-    print "not " unless tell($f) == 9;
-    ok;
-    print "not " unless seek($f,0,0);
-    ok;
+
+    ok( -f "afile",                     '       -f' );
+    ok( (print $f "SomeData\n"),        '       print' );
+    is( tell($f), 9,                    '       tell' );
+    ok( seek($f,0,0),                   '       seek set' );
+
     $b = <$f>;
-    print "not " unless $b eq "SomeData\n";
-    ok;
-    print "not " unless -f $f;
-    ok;
+    is( $b, "SomeData\n",               '       readline' );
+    ok( -f $f,                          '       still a file' );
+
     eval  { die "Message" };
-    # warn $@;
-    print "not " unless $@ =~ /<\$f> line 1/;
-    ok;
-    print "not " unless close($f);
-    ok;
+    like( $@, qr/<\$f> line 1/,         '       proper die message' );
+    ok( close($f),                      '       close' );
+
     unlink("afile");
 }
 
-# 42..44
 {
-    print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' < 10;
-    ok;
+    ok( open(local $f,'>', 'afile'),    'open local $f, ">", ...' );
+    ok( (print $f "a row\n"),           '       print');
+    ok( close($f),                      '       close');
+    ok( -s 'afile' < 10,                '       -s' );
 }
 
-# 45..47
 {
-    print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
-    ok;
-    print $f "a row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 10;
-    ok;
+    ok( open(local $f,'>>', 'afile'),   'open local $f, ">>", ...' );
+    ok( (print $f "a row\n"),           '       print');
+    ok( close($f),                      '       close');
+    ok( -s 'afile' > 10,                '       -s' );
 }
 
-# 48..50
 {
-    print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
+    ok( open(local $f, '<', 'afile'),   'open local $f, "<", ...' );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline list context' );
+    ok( close($f),                      '       close' );
 }
 
-# 51..55
+ok( -s 'afile' < 20,                '       -s' );
+
 {
-    print "not " unless -s 'afile' < 20;
-    ok;
-    print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    seek $f, 0, 1;
-    print $f "yet another row\n";
-    print "not " unless close($f);
-    ok;
-    print "not " unless -s 'afile' > 20;
-    ok;
+    ok( open(local $f, '+<', 'afile'),  'open local $f, "+<", ...' );
+    my @rows = <$f>;
+    is( scalar @rows, 2,                '       readline list context' );
+    ok( seek($f, 0, 1),                 '       seek cur' );
+    ok( (print $f "yet another row\n"), '       print' );
+    ok( close($f),                      '       close' );
+    ok( -s 'afile' > 20,                '       -s' );
 
     unlink("afile");
 }
 
-# 56..58
-if ($Is_VMS) {
-    for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
-}
-else {
-    print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
-    ./perl -e "print qq(a row\n); print qq(another row\n)"
+SKIP: {
+    skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
+
+    ok( open(local $f, '-|', <<EOC),  'open local $f, "-|", ...' );
+    $^X -e "print qq(a row\n); print qq(another row\n)"
 EOC
-    ok;
-    @rows = <$f>;
-    print "not " unless @rows == 2;
-    ok;
-    print "not " unless close($f);
-    ok;
-}
+    my @rows = <$f>;
 
-# 59..62
-if ($Is_VMS) {
-    for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+    is( scalar @rows, 2,                '       readline list context' );
+    ok( close($f),                      '       close' );
 }
-else {
-    print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
-    ./perl -pe "s/^not //"
+
+{
+    ok( open(local $f, '|-', <<EOC),  'open local $f, "|-", ...' );
+    $^X -pe "s/^not //"
 EOC
-    ok;
-    @rows = <$f>;
-    print $f "not ok $test\n"; $test++;
-    print $f "not ok $test\n"; $test++;
-    print "#\nnot " unless close($f);
+
+    my @rows = <$f>;
+    my $test = curr_test;
+    print $f "not ok $test - piping\n";
+    next_test;
+
+    $test = curr_test;
+    print $f "not ok $test - piping\n";
+    next_test;
+    ok( close($f),                      '       close' );
     sleep 1;
-    ok;
+    pass("Flush");
 }
 
-# 63..64
-eval <<'EOE' and print "not ";
-open local $f, '<&', 'afile';
-1;
-EOE
-ok;
-$@ =~ /Bad filehandle:\s+afile/ or print "not ";
-ok;
 
-# 65..66
+ok( !eval { open local $f, '<&', 'afile'; 1 },  'local <& on non-filehandle');
+like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
+
+
 {
     local *F;
     for (1..2) {
-        if ($Is_Dos) {
-        open(F, "echo \\#foo|") or print "not ";
-        } else {
-            open(F, "echo #foo|") or print "not ";
-        }
-	print <F>;
-	close F;
+        ok( open(F, qq{$^X -le "print 'ok'"|}), 'open to pipe' );
+	is(scalar <F>, "ok\n",  '       readline');
+        ok( close F,            '       close' );
     }
-    ok;
+
     for (1..2) {
-        if ($Is_Dos) {
-	open(F, "-|", "echo \\#foo") or print "not ";
-        } else {
-            open(F, "-|", "echo #foo") or print "not ";
-        }
-	print <F>;
-	close F;
+        ok( open(F, "-|", qq{$^X -le "print 'ok'"}), 'open -|');
+        is( scalar <F>, "ok\n", '       readline');
+	ok( close F,            '       close' );
     }
-    ok;
 }
 
-# 67..70 - magic temporary file via 3 arg open with undef
+# magic temporary file via 3 arg open with undef
 {
-    open(my $x,"+<",undef) or print "not ";
-    ok;
-    print "not " unless defined(fileno($x));
-    ok;
+    ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
+    ok( defined fileno($x),     '       fileno' );
+
     select $x;
-    ok;   # goes to $x
+    ok( (print "ok\n"),         '       print' );
+
     select STDOUT;
-    seek($x,0,0);
-    print <$x>;
-    print "not " unless tell($x) > 3;
-    ok;
+    ok( seek($x,0,0),           '       seek' );
+    is( scalar <$x>, "ok\n",    '       readline' );
+    ok( tell($x) >= 3,          '       tell' );
 }
diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t
index 6345a79..499189a 100644
--- a/t/run/kill_perl.t
+++ b/t/run/kill_perl.t
@@ -69,17 +69,11 @@ foreach my $prog (@prgs) {
     close TEST or die "Cannot close $tmpfile: $!";
 
     my $results;
-    if ($^O eq 'MSWin32') {
-        $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
-    }
-    elsif ($^O eq 'NetWare') {
-        $results = `perl -I../lib $switch $tmpfile 2>&1`;
-    }
-    elsif ($^O eq 'MacOS') {
-	$results = `$^X -I::lib -MMac::err=unix $switch $tmpfile`;
+    if ($^O eq 'MacOS') {
+        $results = `$^X -I::lib -MMac::err=unix $switch $tmpfile`;
     }
     else {
-      $results = `./perl "-I../lib" $switch $tmpfile 2>&1`;
+        $results = `$^X "-I../lib" $switch $tmpfile 2>&1`;
     }
     my $status = $?;
 
diff --git a/t/test.pl b/t/test.pl
index e54d53e..5ed6c82 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -15,22 +15,22 @@ sub plan {
 	my %plan = @_;
 	$n = $plan{tests}; 
     }
-    print "1..$n\n";
+    print STDOUT "1..$n\n";
     $planned = $n;
 }
 
 END {
     my $ran = $test - 1;
     if (defined $planned && $planned != $ran) {
-	print "# Looks like you planned $planned tests but ran $ran.\n";
+	print STDOUT "# Looks like you planned $planned tests but ran $ran.\n";
     }
 }
 
 sub skip_all {
     if (@_) {
-	print "1..0 - @_\n";
+	print STDOUT "1..0 - @_\n";
     } else {
-	print "1..0\n";
+	print STDOUT "1..0\n";
     }
     exit(0);
 }
@@ -47,15 +47,15 @@ sub _ok {
     }
 
     $out .= " # TODO $TODO" if $TODO;
-    print "$out\n";
+    print STDOUT "$out\n";
 
     unless ($pass) {
-	print "# Failed $where\n";
+	print STDOUT "# Failed $where\n";
     }
 
     # Ensure that the message is properly escaped.
-    print map { /^#/ ? "$_\n" : "# $_\n" } 
-          map { split /\n/ } @mess if @mess;
+    print STDOUT map { /^#/ ? "$_\n" : "# $_\n" } 
+                 map { split /\n/ } @mess if @mess;
 
     $test++;
 
@@ -127,6 +127,10 @@ sub fail {
     _ok(0, _where(), @_);
 }
 
+sub curr_test {
+    return $test;
+}
+
 sub next_test {
     $test++
 }
@@ -137,7 +141,7 @@ sub skip {
     my $why = shift;
     my $n    = @_ ? shift : 1;
     for (1..$n) {
-	print "ok $test # skip: $why\n";
+        print STDOUT "ok $test # skip: $why\n";
         $test++;
     }
     local $^W = 0;
@@ -245,7 +249,7 @@ sub runperl {
     if ($args{verbose}) {
 	my $runperldisplay = $runperl;
 	$runperldisplay =~ s/\n/\n\#/g;
-	print "# $runperldisplay\n";
+	print STDOUT "# $runperldisplay\n";
     }
     my $result = `$runperl`;
     $result =~ s/\n\n/\n/ if $is_vms; # XXX pipes sometimes double these
@@ -254,7 +258,7 @@ sub runperl {
 
 
 sub BAILOUT {
-    print "Bail out! @_\n";
+    print STDOUT "Bail out! @_\n";
     exit;
 }