t/io/argv.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 BEGIN { require "./test.pl"; }
   9
  10 plan(tests => 37);
  11
  12 my ($devnull, $no_devnull);
  13
  14 if (is_miniperl()) {
  15     $no_devnull = "no dynamic loading on miniperl, File::Spec not built, so can't determine /dev/null";
  16 } else {
  17     require File::Spec;
  18     $devnull = File::Spec->devnull;
  19 }
  20
  21 open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
  22 print TRY "a line\n";
  23 close TRY or die "Could not close: $!";
  24 open(TRY, '>Io_argv2.tmp') || (die "Can't open temp file: $!");
  25 print TRY "another line\n";
  26 close TRY or die "Could not close: $!";
  27
  28 $x = runperl(
  29     prog        => 'while (<>) { print $., $_; }',
  30     args        => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ],
  31 );
  32 is($x, "1a line\n2a line\n", '<> from two files');
  33
  34 {
  35     $x = runperl(
  36         prog    => 'while (<>) { print $_; }',
  37         stdin   => "foo\n",
  38         args    => [ 'Io_argv1.tmp', '-' ],
  39     );
  40     is($x, "a line\nfoo\n", '<> from a file and STDIN');
  41
  42     # readline should behave as <>, not <<>>
  43     $x = runperl(
  44         prog    => 'while (readline) { print $_; }',
  45         stdin   => "foo\n",
  46         stderr  => 1,
  47         args    => [ '-' ],
  48     );
  49     is($x, "foo\n", 'readline() from STDIN');
  50
  51     $x = runperl(
  52         prog    => 'while (<>) { print $_; }',
  53         stdin   => "foo\n",
  54     );
  55     is($x, "foo\n", '<> from just STDIN');
  56
  57     $x = runperl(
  58         prog    => 'while (<>) { print $ARGV.q/,/.$_ }',
  59         args    => [ 'Io_argv1.tmp', 'Io_argv2.tmp' ],
  60     );
  61     is($x, "Io_argv1.tmp,a line\nIo_argv2.tmp,another line\n", '$ARGV is the file name');
  62
  63     $x = runperl(
  64         prog    => 'print $ARGV while <>',
  65         stdin   => "foo\nbar\n",
  66         args    => [ '-' ],
  67     );
  68     is($x, "--", '$ARGV is - for explicit STDIN');
  69
  70     $x = runperl(
  71         prog    => 'print $ARGV while <>',
  72         stdin   => "foo\nbar\n",
  73     );
  74     is($x, "--", '$ARGV is - for implicit STDIN');
  75 }
  76
  77 {
  78     # 5.10 stopped autovivifying scalars in globs leading to a
  79     # segfault when $ARGV is written to.
  80     runperl( prog => 'eof()', stdin => "nothing\n" );
  81     is( 0+$?, 0, q(eof() doesn't segfault) );
  82 }
  83
  84 @ARGV = is_miniperl() ? ('Io_argv1.tmp', 'Io_argv1.tmp', 'Io_argv1.tmp')
  85     : ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
  86 while (<>) {
  87     $y .= $. . $_;
  88     if (eof()) {
  89         is($., 3, '$. counts <>');
  90     }
  91 }
  92
  93 is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
  94
  95
  96 open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
  97 close TRY or die "Could not close: $!";
  98 open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
  99 close TRY or die "Could not close: $!";
 100 @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
 101 $^I = '_bak';   # not .bak which confuses VMS
 102 $/ = undef;
 103 my $i = 11;
 104 while (<>) {
 105     s/^/ok $i\n/;
 106     ++$i;
 107     print;
 108     next_test();
 109 }
 110 open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
 111 print while <TRY>;
 112 open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
 113 print while <TRY>;
 114 close TRY or die "Could not close: $!";
 115 undef $^I;
 116
 117 ok( eof TRY );
 118
 119 {
 120     no warnings 'once';
 121     ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
 122 }
 123
 124 open STDIN, 'Io_argv1.tmp' or die $!;
 125 @ARGV = ();
 126 ok( !eof(),     'STDIN has something' );
 127
 128 is( <>, "ok 11\n" );
 129
 130 SKIP: {
 131     skip_if_miniperl($no_devnull, 4);
 132     open STDIN, $devnull or die $!;
 133     @ARGV = ();
 134     ok( eof(),      'eof() true with empty @ARGV' );
 135
 136     @ARGV = ('Io_argv1.tmp');
 137     ok( !eof() );
 138
 139     @ARGV = ($devnull, $devnull);
 140     ok( !eof() );
 141
 142     close ARGV or die $!;
 143     ok( eof(),      'eof() true after closing ARGV' );
 144 }
 145
 146 SKIP: {
 147     local $/;
 148     open my $fh, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
 149     <$fh>;      # set $. = 1
 150     is( <$fh>, undef );
 151
 152     skip_if_miniperl($no_devnull, 5);
 153
 154     open $fh, $devnull or die;
 155     ok( defined(<$fh>) );
 156
 157     is( <$fh>, undef );
 158     is( <$fh>, undef );
 159
 160     open $fh, $devnull or die;  # restart cycle again
 161     ok( defined(<$fh>) );
 162     is( <$fh>, undef );
 163     close $fh or die "Could not close: $!";
 164 }
 165
 166 open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
 167 print TRY "one\n\nthree\n";
 168 close TRY or die "Could not close: $!";
 169
 170 $x = runperl(
 171     prog        => 'print $..$ARGV.$_ while <<>>',
 172     args        => [ 'Io_argv1.tmp' ],
 173 );
 174 is($x, "1Io_argv1.tmpone\n2Io_argv1.tmp\n3Io_argv1.tmpthree\n", '<<>>');
 175
 176 $x = runperl(
 177     prog        => '$w=q/b/;$w.=<<>>;print $w',
 178     args        => [ 'Io_argv1.tmp' ],
 179 );
 180 is($x, "bone\n", '<<>> and rcatline');
 181
 182 $x = runperl(
 183     prog        => 'while (<<>>) { print }',
 184     stdin       => "foo\n",
 185 );
 186 is($x, "foo\n", '<<>> from just STDIN (no argument)');
 187
 188 $x = runperl(
 189     prog        => 'print $ARGV.q/,/ for <<>>',
 190     stdin       => "foo\nbar\n",
 191 );
 192 is($x, "-,-,", '$ARGV is - for STDIN with <<>>');
 193
 194 $x = runperl(
 195     prog        => 'while (<<>>) { print $_; }',
 196     stdin       => "foo\n",
 197     stderr      => 1,
 198     args        => [ '-' ],
 199 );
 200 like($x, qr/^Can't open -: .* at -e line 1/, '<<>> does not treat - as STDIN');
 201
 202 {
 203     # tests for an empty string in @ARGV
 204     $x = runperl(
 205         prog    => 'push @ARGV,q//;print while <>',
 206         stderr  => 1,
 207     );
 208     like($x, qr/^Can't open : .* at -e line 1/, '<> does not open empty string in ARGV');
 209
 210     $x = runperl(
 211         prog    => 'push @ARGV,q//;print while <<>>',
 212         stderr  => 1,
 213     );
 214     like($x, qr/^Can't open : .* at -e line 1/, '<<>> does not open empty string in ARGV');
 215 }
 216
 217 SKIP: {
 218     skip('no echo', 2) unless -x '/bin/echo';
 219
 220     $x = runperl(
 221         prog    => 'while (<<>>) { print $_; }',
 222         stderr  => 1,
 223         args    => [ '"echo foo |"' ],
 224     );
 225     like($x, qr/^Can't open echo foo \|: .* at -e line 1/, '<<>> does not treat ...| as fork');
 226
 227     $x = runperl(
 228         prog    => 'while (<<>>) { }',
 229         stderr  => 1,
 230         args    => [ 'Io_argv1.tmp', '"echo foo |"' ],
 231     );
 232     like($x, qr/^Can't open echo foo \|: .* at -e line 1, <> line 3/, '<<>> does not treat ...| as fork after eof');
 233 }
 234
 235 # This used to dump core
 236 fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" );
 237 open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!";
 238 print OUT "foo";
 239 close OUT;
 240 open IN, "Io_argv3.tmp" or die "Can't open temp file: $!";
 241 *ARGV = *IN;
 242 while (<>) {
 243     print;
 244     print "bar" if eof();
 245 }
 246 close IN;
 247 unlink "Io_argv3.tmp";
 248 **PROG**
 249
 250 # This used to fail an assertion.
 251 # The tricks with *x and $x are to make PL_argvgv point to a freed SV when
 252 # the readline op does SvREFCNT_inc on it.  undef *x clears the scalar slot
 253 # ++$x vivifies it, reusing the just-deleted GV that PL_argvgv still points
 254 # to.  The BEGIN block ensures it is freed late enough that nothing else
 255 # has reused it yet.
 256 is runperl(prog => 'undef *x; delete $::{ARGV}; $x++;'
 257                   .'eval q-BEGIN{undef *x} readline-; print qq-ok\n-'),
 258   "ok\n", 'deleting $::{ARGV}';
 259
 260 END {
 261     unlink_all 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
 262         'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';
 263 }