This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make utf8::encode respect magic
[perl5.git] / 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 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
25 $x = runperl(
26     prog        => 'while (<>) { print $., $_; }',
27     args        => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ],
28 );
29 is($x, "1a line\n2a line\n", '<> from two files');
30
31 {
32     $x = runperl(
33         prog    => 'while (<>) { print $_; }',
34         stdin   => "foo\n",
35         args    => [ 'Io_argv1.tmp', '-' ],
36     );
37     is($x, "a line\nfoo\n", '   from a file and STDIN');
38
39     $x = runperl(
40         prog    => 'while (<>) { print $_; }',
41         stdin   => "foo\n",
42     );
43     is($x, "foo\n", '   from just STDIN');
44 }
45
46 {
47     # 5.10 stopped autovivifying scalars in globs leading to a
48     # segfault when $ARGV is written to.
49     runperl( prog => 'eof()', stdin => "nothing\n" );
50     is( 0+$?, 0, q(eof() doesn't segfault) );
51 }
52
53 @ARGV = is_miniperl() ? ('Io_argv1.tmp', 'Io_argv1.tmp', 'Io_argv1.tmp')
54     : ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
55 while (<>) {
56     $y .= $. . $_;
57     if (eof()) {
58         is($., 3, '$. counts <>');
59     }
60 }
61
62 is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
63
64
65 open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
66 close TRY or die "Could not close: $!";
67 open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
68 close TRY or die "Could not close: $!";
69 @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
70 $^I = '_bak';   # not .bak which confuses VMS
71 $/ = undef;
72 my $i = 7;
73 while (<>) {
74     s/^/ok $i\n/;
75     ++$i;
76     print;
77     next_test();
78 }
79 open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
80 print while <TRY>;
81 open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
82 print while <TRY>;
83 close TRY or die "Could not close: $!";
84 undef $^I;
85
86 ok( eof TRY );
87
88 {
89     no warnings 'once';
90     ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
91 }
92
93 open STDIN, 'Io_argv1.tmp' or die $!;
94 @ARGV = ();
95 ok( !eof(),     'STDIN has something' );
96
97 is( <>, "ok 7\n" );
98
99 SKIP: {
100     skip_if_miniperl($no_devnull, 4);
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 SKIP: {
116     local $/;
117     open my $fh, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
118     <$fh>;      # set $. = 1
119     is( <$fh>, undef );
120
121     skip_if_miniperl($no_devnull, 5);
122
123     open $fh, $devnull or die;
124     ok( defined(<$fh>) );
125
126     is( <$fh>, undef );
127     is( <$fh>, undef );
128
129     open $fh, $devnull or die;  # restart cycle again
130     ok( defined(<$fh>) );
131     is( <$fh>, undef );
132     close $fh or die "Could not close: $!";
133 }
134
135 # This used to dump core
136 fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" ); 
137 open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!";
138 print OUT "foo";
139 close OUT;
140 open IN, "Io_argv3.tmp" or die "Can't open temp file: $!";
141 *ARGV = *IN;
142 while (<>) {
143     print;
144     print "bar" if eof();
145 }
146 close IN;
147 unlink "Io_argv3.tmp";
148 **PROG**
149
150 END {
151     unlink_all 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
152         'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';
153 }