1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
BEGIN { require "./test.pl"; }
plan(tests => 23);
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 or die "Could not close: $!";
$x = runperl(
prog => 'while (<>) { print $., $_; }',
args => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ],
);
is($x, "1a line\n2a line\n", '<> from two files');
{
$x = runperl(
prog => 'while (<>) { print $_; }',
stdin => "foo\n",
args => [ 'Io_argv1.tmp', '-' ],
);
is($x, "a line\nfoo\n", ' from a file and STDIN');
$x = runperl(
prog => 'while (<>) { print $_; }',
stdin => "foo\n",
);
is($x, "foo\n", ' from just STDIN');
}
{
# 5.10 stopped autovivifying scalars in globs leading to a
# segfault when $ARGV is written to.
runperl( prog => 'eof()', stdin => "nothing\n" );
is( 0+$?, 0, q(eof() doesn't segfault) );
}
@ARGV = ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
while (<>) {
$y .= $. . $_;
if (eof()) {
is($., 3, '$. counts <>');
}
}
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 = 7;
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 or die "Could not close: $!";
undef $^I;
ok( eof TRY );
{
no warnings 'once';
ok( eof NEVEROPENED, 'eof() true on unopened filehandle' );
}
open STDIN, 'Io_argv1.tmp' or die $!;
@ARGV = ();
ok( !eof(), 'STDIN has something' );
is( <>, "ok 7\n" );
open STDIN, $devnull or die $!;
@ARGV = ();
ok( eof(), 'eof() true with empty @ARGV' );
@ARGV = ('Io_argv1.tmp');
ok( !eof() );
@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: $!";
<F>; # set $. = 1
is( <F>, undef );
open F, $devnull or die;
ok( defined(<F>) );
is( <F>, undef );
is( <F>, undef );
open F, $devnull or die; # restart cycle again
ok( defined(<F>) );
is( <F>, 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';
}
|