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