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?