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