Re: [PATCH t/io/argv.t vms/test.com t/test.pl] argv.t cleanup & fixes for VMS

Message-ID: <20011107020229.K2858@blackrider>

p4raw-id: //depot/perl@12901

diff --git a/t/io/argv.t b/t/io/argv.t
index 5df3420..3840f65 100755 (executable)
--- a/t/io/argv.t
+++ b/t/io/argv.t
@@ -5,131 +5,127 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..21\n";
+sub runthis {
+    my($prog, $stdin, @files) = @_;
+
+    my $cmd = '';
+    if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' ) {
+        $cmd = qq{$^X -e "$prog"};
+        $cmd .= " ". join ' ', map qq{"$_"}, @files if @files;
+        $cmd = qq{$^X -le "print '$stdin'" | } . $cmd if defined $stdin;
+    }
+    else {
+        $cmd = qq{$^X -e '$prog' @files};
+        $cmd = qq{$^X -le 'print q{$stdin}' | } . $cmd if defined $stdin;
+    }
+
+    # The combination of $^X, pipes and STDIN is broken on VMS and
+    # will hang.
+    if( defined $stdin && $^O eq 'VMS' && $TODO ) {
+        return 0;
+    }
+
+    my $result = `$cmd`;
+    $result =~ s/\n\n/\n/ if $^O eq 'VMS'; # pipes sometimes double these
+
+    return $result;
+}
+
+    
+require "./test.pl";
+plan(tests => 21);
 
 use File::Spec;
 
 my $devnull = File::Spec->devnull;
 
-open(try, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
-print try "a line\n";
-close try;
+open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
+print TRY "a line\n";
+close TRY;
 
-if ($^O eq 'MSWin32') {
-  $x = `.\\perl -e "while (<>) {print \$.,\$_;}" Io_argv1.tmp Io_argv1.tmp`;
-}
-elsif ($^O eq 'NetWare') {
-  $x = `perl -e "while (<>) {print \$.,\$_;}" Io_argv1.tmp Io_argv1.tmp`;
-}
-else {
-  $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io_argv1.tmp Io_argv1.tmp`;
-}
-if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";}
+$x = runthis( 'while (<>) { print $., $_; }', undef, ('Io_argv1.tmp') x 2);
+is($x, "1a line\n2a line\n", '<> from two files');
 
-if ($^O eq 'MSWin32') {
-  $x = `.\\perl -le "print 'foo'" | .\\perl -e "while (<>) {print \$_;}" Io_argv1.tmp -`;
-}
-elsif ($^O eq 'NetWare') {
-  $x = `perl -le "print 'foo'" | perl -e "while (<>) {print \$_;}" Io_argv1.tmp -`;
-}
-else {
-  $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io_argv1.tmp -`;
-}
-if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
+{
+    local $TODO = 'The combo of STDIN, pipes and $^X is broken on VMS'
+      if $^O eq 'VMS';
+    $x = runthis( 'while (<>) { print $_; }', 'foo', 'Io_argv1.tmp', '-' );
+    is($x, "a line\nfoo\n", '   from a file and STDIN');
 
-if ($^O eq 'MSWin32') {
-  $x = `.\\perl -le "print 'foo'" |.\\perl -e "while (<>) {print \$_;}"`;
-}
-elsif ($^O eq 'NetWare') {
-  $x = `perl -le "print 'foo'" | perl -e "while (<>) {print \$_;}"`;
+    $x = runthis( 'while (<>) {print $_;}', 'foo' );
+    is($x, "foo\n", '   from just STDIN');
 }
-else {
-  $x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
-}
-if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";}
 
 @ARGV = ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
 while (<>) {
     $y .= $. . $_;
     if (eof()) {
-       if ($. == 3) {print "ok 4\n";} else {print "not ok 4\n";}
+       is($., 3, '$. counts <>');
     }
 }
 
-if ($y eq "1a line\n2a line\n3a line\n")
-    {print "ok 5\n";}
-else
-    {print "not ok 5\n";}
+is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
+
 
-open(try, '>Io_argv1.tmp') or die "Can't open temp file: $!";
-close try;
-open(try, '>Io_argv2.tmp') or die "Can't open temp file: $!";
-close try;
+open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
+close TRY;
+open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
+close TRY;
 @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
-$^I = '.bak';
+$^I = '_bak';   # not .bak which confuses VMS
 $/ = undef;
 my $i = 6;
 while (<>) {
     s/^/ok $i\n/;
     ++$i;
     print;
+    next_test();
 }
-open(try, '<Io_argv1.tmp') or die "Can't open temp file: $!";
-print while <try>;
-open(try, '<Io_argv2.tmp') or die "Can't open temp file: $!";
-print while <try>;
-close try;
+open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
+print while <TRY>;
+open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
+print while <TRY>;
+close TRY;
 undef $^I;
 
-eof try or print 'not ';
-print "ok 8\n";
+ok( eof TRY );
 
-eof NEVEROPENED or print 'not ';
-print "ok 9\n";
+ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
 
 open STDIN, 'Io_argv1.tmp' or die $!;
 @ARGV = ();
-!eof() or print 'not ';
-print "ok 10\n";
+ok( !eof(),     'STDIN has something' );
 
-<> eq "ok 6\n" or print 'not ';
-print "ok 11\n";
+is( <>, "ok 6\n" );
 
 open STDIN, $devnull or die $!;
 @ARGV = ();
-eof() or print 'not ';
-print "ok 12\n";
+ok( eof(),      'eof() true with empty @ARGV' );
 
 @ARGV = ('Io_argv1.tmp');
-!eof() or print 'not ';
-print "ok 13\n";
+ok( !eof() );
 
 @ARGV = ($devnull, $devnull);
-!eof() or print 'not ';
-print "ok 14\n";
+ok( !eof() );
 
 close ARGV or die $!;
-eof() or print 'not ';
-print "ok 15\n";
+ok( eof(),      'eof() true after closing ARGV' );
 
 {
     local $/;
     open F, 'Io_argv1.tmp' or die;
     <F>;       # set $. = 1
-    print "not " if defined(<F>); # should hit eof
-    print "ok 16\n";
+    is( <F>, undef );
+
     open F, $devnull or die;
-    print "not " unless defined(<F>);
-    print "ok 17\n";
-    print "not " if defined(<F>);
-    print "ok 18\n";
-    print "not " if defined(<F>);
-    print "ok 19\n";
+    ok( defined(<F>) );
+
+    is( <F>, undef );
+    is( <F>, undef );
+
     open F, $devnull or die;   # restart cycle again
-    print "not " unless defined(<F>);
-    print "ok 20\n";
-    print "not " if defined(<F>);
-    print "ok 21\n";
+    ok( defined(<F>) );
+    is( <F>, undef );
     close F;
 }
 

diff --git a/t/test.pl b/t/test.pl
index 6caa865..87cb51a 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -5,6 +5,8 @@
 my $test = 1;
 my $planned;
 
+$TODO = 0;
+
 sub plan {
     my $n;
     if (@_ == 1) {
@@ -34,17 +36,27 @@ sub skip_all {
 }
 
 sub _ok {
-    my ($pass, $where, @mess) = @_;
+    my ($pass, $where, $name, @mess) = @_;
     # Do not try to microoptimize by factoring out the "not ".
     # VMS will avenge.
-    if (@mess) {
-       print $pass ? "ok $test - @mess\n" : "not ok $test - @mess\n";
+    my $out;
+    if ($name) {
+       $out = $pass ? "ok $test - $name" : "not ok $test - $name";
     } else {
-       print $pass ? "ok $test\n" : "not ok $test\n";
+       $out = $pass ? "ok $test" : "not ok $test";
     }
+
+    $out .= " # TODO $TODO" if $TODO;
+    print "$out\n";
+
     unless ($pass) {
        print "# Failed $where\n";
     }
+
+    # Ensure that the message is properly escaped.
+    print map { /^#/ ? "$_\n" : "# $_\n" } 
+          map { split /\n/ } @mess if @mess;
+
     $test++;
 
     return $pass;
@@ -56,27 +68,25 @@ sub _where {
 }
 
 sub ok {
-    my ($pass, @mess) = @_;
-    _ok($pass, _where(), @mess);
+    my ($pass, $name, @mess) = @_;
+    _ok($pass, _where(), $name, @mess);
 }
 
 sub is {
-    my ($got, $expected, @mess) = @_;
+    my ($got, $expected, $name, @mess) = @_;
     my $pass = $got eq $expected;
     unless ($pass) {
-       unshift(@mess, "\n",
-               "#      got '$got'\n",
-               "# expected '$expected'\n");
+       unshift(@mess, "#      got '$got'\n",
+                      "# expected '$expected'\n");
     }
-    _ok($pass, _where(), @mess);
+    _ok($pass, _where(), $name, @mess);
 }
 
 sub isnt {
     my ($got, $isnt, $name, @mess) = @_;
     my $pass = $got ne $isnt;
     unless( $pass ) {
-        unshift(@mess, "# It should not be " .
-                      ( defined $got ? $got : "undef" ) . "\n",
+        unshift(@mess, "# it should not be $got\n",
                        "# but it is.\n");
     }
     _ok($pass, _where(), $name, @mess);
@@ -84,23 +94,21 @@ sub isnt {
 
 # Note: this isn't quite as fancy as Test::More::like().
 sub like {
-    my ($got, $expected, @mess) = @_;
+    my ($got, $expected, $name, @mess) = @_;
     my $pass;
     if (ref $expected eq 'Regexp') {
        $pass = $got =~ $expected;
        unless ($pass) {
-           unshift(@mess, "\n",
-                   "#      got '$got'\n");
+           unshift(@mess, "#      got '$got'\n");
        }
     } else {
        $pass = $got =~ /$expected/;
        unless ($pass) {
-           unshift(@mess, "\n",
-                   "#      got '$got'\n",
-                   "# expected /$expected/\n");
+           unshift(@mess, "#      got '$got'\n",
+                          "# expected /$expected/\n");
        }
     }
-    _ok($pass, _where(), @mess);
+    _ok($pass, _where(), $name, @mess);
 }
 
 sub pass {
@@ -118,10 +126,10 @@ sub next_test {
 # Note: can't pass multipart messages since we try to
 # be compatible with Test::More::skip().
 sub skip {
-    my $mess = shift;
+    my $why = shift;
     my $n    = @_ ? shift : 1;
     for (1..$n) {
-       ok(1, "# skip:", $mess);
+       ok(1, "# skip:", $why);
     }
     local $^W = 0;
     last SKIP;

diff --git a/vms/test.com b/vms/test.com
index 6720dba..c9ce2d3 100644 (file)
--- a/vms/test.com
+++ b/vms/test.com
@@ -115,7 +115,7 @@ use Config;
 use File::Spec;
 
 @compexcl=('cpp.t');
-@ioexcl=('argv.t','dup.t','pipe.t');
+@ioexcl=('dup.t','pipe.t');
 @libexcl=('db-btree.t','db-hash.t','db-recno.t',
           'gdbm.t','io_dup.t', 'io_pipe.t', 'io_poll.t', 'io_sel.t',
           'io_sock.t', 'io_unix.t',