@INC = '../lib';
}
-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);
+
+plan(tests => 22);
use File::Spec;
open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
print TRY "a line\n";
-close TRY;
+close TRY or die "Could not close: $!";
-$x = runthis( 'while (<>) { print $., $_; }', undef, ('Io_argv1.tmp') x 2);
+$x = runperl(
+ prog => 'while (<>) { print $., $_; }',
+ args => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ],
+);
is($x, "1a line\n2a line\n", '<> from two files');
{
- 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', '-' );
+ $x = runperl(
+ prog => 'while (<>) { print $_; }',
+ stdin => "foo\n",
+ args => [ 'Io_argv1.tmp', '-' ],
+ );
is($x, "a line\nfoo\n", ' from a file and STDIN');
- $x = runthis( 'while (<>) {print $_;}', 'foo' );
+ $x = runperl(
+ prog => 'while (<>) { print $_; }',
+ stdin => "foo\n",
+ );
is($x, "foo\n", ' from just STDIN');
}
open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
-close TRY;
+close TRY or die "Could not close: $!";
open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
-close TRY;
+close TRY or die "Could not close: $!";
@ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
$^I = '_bak'; # not .bak which confuses VMS
$/ = undef;
print while <TRY>;
open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
print while <TRY>;
-close TRY;
+close TRY or die "Could not close: $!";
undef $^I;
ok( eof TRY );
{
local $/;
- open F, 'Io_argv1.tmp' or die;
+ open F, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
<F>; # set $. = 1
is( <F>, undef );
open F, $devnull or die; # restart cycle again
ok( defined(<F>) );
is( <F>, undef );
- close F;
+ close F or die "Could not close: $!";
}
-END { unlink 'Io_argv1.tmp', 'Io_argv1.tmp.bak', 'Io_argv2.tmp', 'Io_argv2.tmp.bak' }
+# 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';
+}