[PATCH t/io/argv.t vms/test.com t/test.pl] argv.t cleanup fixes for VMS
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;
Re: [PATCH t/io/argv.t vms/test.com t/test.pl] argv.t cleanup fixes for VMS
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);
Re: [PATCH t/test.pl] Adding isnt() and next_test()
On Tue, Nov 06, 2001 at 08:58:45PM -0500, Michael G Schwern wrote: In the course of revamping t/io/argv.t for VMS, I've added two functions to t/test.pl. isnt() is useful for replacing this sort of thing: print not unless defined $foo; print ok 42\n; with isnt($foo, undef); The advantage being if it fails $foo will be printed out. next_test() just increments the test counter. This is good for tests which just can't be wedged into the interface. It prints the ok, and then next_test() is called to make test.pl's counter happy. Thanks, applied. (With a slight change so that undef values are printed as undef.) -- $jhi++; # http://www.iki.fi/jhi/ # There is this special biologist word we use for 'stable'. # It is 'dead'. -- Jack Cohen
