X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fio%2Fargv.t;h=33c4f1a8e7e848cf16b67f80ade45d581f525d66;hb=cc8040a133daf622c9005eb6ffea6375088dc5e7;hp=cee43fc46eba27802b86b39603be09f71bb7015b;hpb=79072805bf63abe5b5978b5928ab00d360ea3e7f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/io/argv.t b/t/io/argv.t index cee43fc..33c4f1a 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -1,36 +1,132 @@ #!./perl -# $RCSfile: argv.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:25 $ +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} -print "1..5\n"; +require "./test.pl"; -open(try, '>Io.argv.tmp') || (die "Can't open temp file."); -print try "a line\n"; -close try; +plan(tests => 22); -$x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; +use File::Spec; -if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} +my $devnull = File::Spec->devnull; -$x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; +open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!"); +print TRY "a line\n"; +close TRY or die "Could not close: $!"; -if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} +$x = runperl( + prog => 'while (<>) { print $., $_; }', + args => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ], +); +is($x, "1a line\n2a line\n", '<> from two files'); -$x = `echo foo|./perl -e 'while (<>) {print $_;}'`; +{ + $x = runperl( + prog => 'while (<>) { print $_; }', + stdin => "foo\n", + args => [ 'Io_argv1.tmp', '-' ], + ); + is($x, "a line\nfoo\n", ' from a file and STDIN'); -if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";} + $x = runperl( + prog => 'while (<>) { print $_; }', + stdin => "foo\n", + ); + is($x, "foo\n", ' from just STDIN'); +} -@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp'); +@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 or die "Could not close: $!"; +open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!"; +close TRY or die "Could not close: $!"; +@ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp'); +$^I = '_bak'; # not .bak which confuses VMS +$/ = undef; +my $i = 6; +while (<>) { + s/^/ok $i\n/; + ++$i; + print; + next_test(); +} +open(TRY, '; +open(TRY, '; +close TRY or die "Could not close: $!"; +undef $^I; + +ok( eof TRY ); + +ok( eof NEVEROPENED, 'eof() true on unopened filehandle' ); + +open STDIN, 'Io_argv1.tmp' or die $!; +@ARGV = (); +ok( !eof(), 'STDIN has something' ); + +is( <>, "ok 6\n" ); + +open STDIN, $devnull or die $!; +@ARGV = (); +ok( eof(), 'eof() true with empty @ARGV' ); + +@ARGV = ('Io_argv1.tmp'); +ok( !eof() ); -`/bin/rm -f Io.argv.tmp`; +@ARGV = ($devnull, $devnull); +ok( !eof() ); + +close ARGV or die $!; +ok( eof(), 'eof() true after closing ARGV' ); + +{ + local $/; + open F, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!"; + ; # set $. = 1 + is( , undef ); + + open F, $devnull or die; + ok( defined() ); + + is( , undef ); + is( , undef ); + + open F, $devnull or die; # restart cycle again + ok( defined() ); + is( , undef ); + close F or die "Could not close: $!"; +} + +# This used to dump core +fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" ); +open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!"; +print OUT "foo"; +close OUT; +open IN, "Io_argv3.tmp" or die "Can't open temp file: $!"; +*ARGV = *IN; +while (<>) { + print; + print "bar" if eof(); +} +close IN; +unlink "Io_argv3.tmp"; +**PROG** + +END { + 1 while unlink 'Io_argv1.tmp', 'Io_argv1.tmp_bak', + 'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp'; +}