On Wed, Nov 07, 2001 at 01:56:40AM -0500, Michael G Schwern wrote:
> On Wed, Nov 07, 2001 at 06:49:58AM +0200, Jarkko Hietaniemi wrote:
> > My patch(1) doesn't like this at all.
>
> Blarg. Maybe things got twisted with all the little t/test.pl patches
> and the ftping back and forth. Lemme try a fresh Perl.
Ok, this is against a clean 12879. Same as before, except it includes
the eariler TODO and name cleanup to t/test.pl. Sorry, thought those
were in.
--- t/io/argv.t 2001/11/07 06:57:36 1.1
+++ t/io/argv.t 2001/11/07 06:57:46
@@ -5,131 +5,127 @@
@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 \$_;}"`;
-}
-else {
- $x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
+ $x = runthis( 'while (<>) {print $_;}', 'foo' );
+ is($x, "foo\n", ' from just STDIN');
}
-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";}
-
-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;
+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;
@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;
}
--- t/test.pl 2001/11/07 06:58:14 1.1
+++ t/test.pl 2001/11/07 06:58:19
@@ -5,6 +5,8 @@
my $test = 1;
my $planned;
+$TODO = 0;
+
sub plan {
my $n;
if (@_ == 1) {
@@ -34,17 +36,27 @@
}
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 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 @@
# 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 @@
# 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;
--- vms/test.com 2001/11/07 06:58:50 1.1
+++ vms/test.com 2001/11/07 06:58:57
@@ -115,7 +115,7 @@
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',
--
Michael G. Schwern <[EMAIL PROTECTED]> http://www.pobox.com/~schwern/
Perl6 Quality Assurance <[EMAIL PROTECTED]> Kwalitee Is Job One
And God was pleased.
And Dog was happy and wagged his tail.
And Adam was greatly improved.
And Cat did not care one way or the other.
-- http://www.catsarefrommars.com/creationist.htm
