t/io/argv.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 sub runthis {
   9     my($prog, $stdin, @files) = @_;
  10
  11     my $cmd = '';
  12     if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' ) {
  13         $cmd = qq{$^X -e "$prog"};
  14         $cmd .= " ". join ' ', map qq{"$_"}, @files if @files;
  15         $cmd = qq{$^X -le "print '$stdin'" | } . $cmd if defined $stdin;
  16     }
  17     else {
  18         $cmd = qq{$^X -e '$prog' @files};
  19         $cmd = qq{$^X -le 'print q{$stdin}' | } . $cmd if defined $stdin;
  20     }
  21
  22     # The combination of $^X, pipes and STDIN is broken on VMS and
  23     # will hang.
  24     if( defined $stdin && $^O eq 'VMS' && $TODO ) {
  25         return 0;
  26     }
  27
  28     my $result = `$cmd`;
  29     $result =~ s/\n\n/\n/ if $^O eq 'VMS'; # pipes sometimes double these
  30
  31     return $result;
  32 }
  33
  34
  35 require "./test.pl";
  36 plan(tests => 21);
  37
  38 use File::Spec;
  39
  40 my $devnull = File::Spec->devnull;
  41
  42 open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
  43 print TRY "a line\n";
  44 close TRY;
  45
  46 $x = runthis( 'while (<>) { print $., $_; }', undef, ('Io_argv1.tmp') x 2);
  47 is($x, "1a line\n2a line\n", '<> from two files');
  48
  49 {
  50     local $TODO = 'The combo of STDIN, pipes and $^X is broken on VMS'
  51       if $^O eq 'VMS';
  52     $x = runthis( 'while (<>) { print $_; }', 'foo', 'Io_argv1.tmp', '-' );
  53     is($x, "a line\nfoo\n", '   from a file and STDIN');
  54
  55     $x = runthis( 'while (<>) {print $_;}', 'foo' );
  56     is($x, "foo\n", '   from just STDIN');
  57 }
  58
  59 @ARGV = ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
  60 while (<>) {
  61     $y .= $. . $_;
  62     if (eof()) {
  63         is($., 3, '$. counts <>');
  64     }
  65 }
  66
  67 is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
  68
  69
  70 open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
  71 close TRY;
  72 open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
  73 close TRY;
  74 @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
  75 $^I = '_bak';   # not .bak which confuses VMS
  76 $/ = undef;
  77 my $i = 6;
  78 while (<>) {
  79     s/^/ok $i\n/;
  80     ++$i;
  81     print;
  82     next_test();
  83 }
  84 open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
  85 print while <TRY>;
  86 open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
  87 print while <TRY>;
  88 close TRY;
  89 undef $^I;
  90
  91 ok( eof TRY );
  92
  93 ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
  94
  95 open STDIN, 'Io_argv1.tmp' or die $!;
  96 @ARGV = ();
  97 ok( !eof(),     'STDIN has something' );
  98
  99 is( <>, "ok 6\n" );
 100
 101 open STDIN, $devnull or die $!;
 102 @ARGV = ();
 103 ok( eof(),      'eof() true with empty @ARGV' );
 104
 105 @ARGV = ('Io_argv1.tmp');
 106 ok( !eof() );
 107
 108 @ARGV = ($devnull, $devnull);
 109 ok( !eof() );
 110
 111 close ARGV or die $!;
 112 ok( eof(),      'eof() true after closing ARGV' );
 113
 114 {
 115     local $/;
 116     open F, 'Io_argv1.tmp' or die;
 117     <F>;        # set $. = 1
 118     is( <F>, undef );
 119
 120     open F, $devnull or die;
 121     ok( defined(<F>) );
 122
 123     is( <F>, undef );
 124     is( <F>, undef );
 125
 126     open F, $devnull or die;    # restart cycle again
 127     ok( defined(<F>) );
 128     is( <F>, undef );
 129     close F;
 130 }
 131
 132 END { unlink 'Io_argv1.tmp', 'Io_argv1.tmp.bak', 'Io_argv2.tmp', 'Io_argv2.tmp.bak' }