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 => 22);
  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 @ARGV = ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
  42 while (<>) {
  43     $y .= $. . $_;
  44     if (eof()) {
  45         is($., 3, '$. counts <>');
  46     }
  47 }
  48
  49 is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
  50
  51
  52 open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
  53 close TRY or die "Could not close: $!";
  54 open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
  55 close TRY or die "Could not close: $!";
  56 @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
  57 $^I = '_bak';   # not .bak which confuses VMS
  58 $/ = undef;
  59 my $i = 6;
  60 while (<>) {
  61     s/^/ok $i\n/;
  62     ++$i;
  63     print;
  64     next_test();
  65 }
  66 open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
  67 print while <TRY>;
  68 open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
  69 print while <TRY>;
  70 close TRY or die "Could not close: $!";
  71 undef $^I;
  72
  73 ok( eof TRY );
  74
  75 {
  76     no warnings 'once';
  77     ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
  78 }
  79
  80 open STDIN, 'Io_argv1.tmp' or die $!;
  81 @ARGV = ();
  82 ok( !eof(),     'STDIN has something' );
  83
  84 is( <>, "ok 6\n" );
  85
  86 open STDIN, $devnull or die $!;
  87 @ARGV = ();
  88 ok( eof(),      'eof() true with empty @ARGV' );
  89
  90 @ARGV = ('Io_argv1.tmp');
  91 ok( !eof() );
  92
  93 @ARGV = ($devnull, $devnull);
  94 ok( !eof() );
  95
  96 close ARGV or die $!;
  97 ok( eof(),      'eof() true after closing ARGV' );
  98
  99 {
 100     local $/;
 101     open F, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
 102     <F>;        # set $. = 1
 103     is( <F>, undef );
 104
 105     open F, $devnull or die;
 106     ok( defined(<F>) );
 107
 108     is( <F>, undef );
 109     is( <F>, undef );
 110
 111     open F, $devnull or die;    # restart cycle again
 112     ok( defined(<F>) );
 113     is( <F>, undef );
 114     close F or die "Could not close: $!";
 115 }
 116
 117 # This used to dump core
 118 fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" );
 119 open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!";
 120 print OUT "foo";
 121 close OUT;
 122 open IN, "Io_argv3.tmp" or die "Can't open temp file: $!";
 123 *ARGV = *IN;
 124 while (<>) {
 125     print;
 126     print "bar" if eof();
 127 }
 128 close IN;
 129 unlink "Io_argv3.tmp";
 130 **PROG**
 131
 132 END {
 133     1 while unlink 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
 134         'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';
 135 }