t/io/argv.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 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 ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
  76
  77 open STDIN, 'Io_argv1.tmp' or die $!;
  78 @ARGV = ();
  79 ok( !eof(),     'STDIN has something' );
  80
  81 is( <>, "ok 6\n" );
  82
  83 open STDIN, $devnull or die $!;
  84 @ARGV = ();
  85 ok( eof(),      'eof() true with empty @ARGV' );
  86
  87 @ARGV = ('Io_argv1.tmp');
  88 ok( !eof() );
  89
  90 @ARGV = ($devnull, $devnull);
  91 ok( !eof() );
  92
  93 close ARGV or die $!;
  94 ok( eof(),      'eof() true after closing ARGV' );
  95
  96 {
  97     local $/;
  98     open F, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
  99     <F>;        # set $. = 1
 100     is( <F>, undef );
 101
 102     open F, $devnull or die;
 103     ok( defined(<F>) );
 104
 105     is( <F>, undef );
 106     is( <F>, undef );
 107
 108     open F, $devnull or die;    # restart cycle again
 109     ok( defined(<F>) );
 110     is( <F>, undef );
 111     close F or die "Could not close: $!";
 112 }
 113
 114 # This used to dump core
 115 fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" );
 116 open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!";
 117 print OUT "foo";
 118 close OUT;
 119 open IN, "Io_argv3.tmp" or die "Can't open temp file: $!";
 120 *ARGV = *IN;
 121 while (<>) {
 122     print;
 123     print "bar" if eof();
 124 }
 125 close IN;
 126 unlink "Io_argv3.tmp";
 127 **PROG**
 128
 129 END {
 130     1 while unlink 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
 131         'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';
 132 }