Plowing through the list of excepted tests in vms/test.com, we start
with t/io/argv.t. This version now works under VMS and Linux. It
should work under Windows as well, but I'd like someone to give it a
shot.
Here's what's been done:
The mixed logic about running programs has been consoldated into
runthis(). At least if I got something wrong it'll be easier to
fix.
Switched from ad hoc tests to t/test.pl
Eliminated as many warnings as I could.
There seems to be a genuine problem with the combination of $^X,
STDIN and pipes in vmsperl. The two tests dealing with this
have been marked as TODO. Working on it.
t/test.pl now properly escapes the diagnostic messages from is()
and isnt().
--- t/test.pl 2001/11/06 21:37:34 1.2
+++ t/test.pl 2001/11/07 02:17:52
@@ -52,7 +52,10 @@
unless ($pass) {
print "# Failed $where\n";
}
- print @mess if @mess;
+
+ # Ensure that the message is properly escaped.
+ print map { /^#/ ? "$_\n" : "# $_\n" }
+ map { split /\n/ } @mess if @mess;
$test++;
--- t/io/argv.t 2001/11/05 22:40:43 1.1
+++ t/io/argv.t 2001/11/07 02:09:47
@@ -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;
}
--- vms/test.com 2001/11/07 02:20:42 1.1
+++ vms/test.com 2001/11/07 02:20:52
@@ -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
I know you get this a lot, but what's an unholy fairy like you doing in a
mosque like this?
