xref: /openbsd-src/gnu/usr.bin/perl/t/io/argv.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6}
7
8BEGIN { require "./test.pl"; }
9
10plan(tests => 24);
11
12my ($devnull, $no_devnull);
13
14if (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
21open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
22print TRY "a line\n";
23close TRY or die "Could not close: $!";
24
25$x = runperl(
26    prog	=> 'while (<>) { print $., $_; }',
27    args	=> [ 'Io_argv1.tmp', 'Io_argv1.tmp' ],
28);
29is($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');
55while (<>) {
56    $y .= $. . $_;
57    if (eof()) {
58	is($., 3, '$. counts <>');
59    }
60}
61
62is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
63
64
65open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
66close TRY or die "Could not close: $!";
67open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
68close TRY or die "Could not close: $!";
69@ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
70$^I = '_bak';   # not .bak which confuses VMS
71$/ = undef;
72my $i = 7;
73while (<>) {
74    s/^/ok $i\n/;
75    ++$i;
76    print;
77    next_test();
78}
79open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
80print while <TRY>;
81open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
82print while <TRY>;
83close TRY or die "Could not close: $!";
84undef $^I;
85
86ok( eof TRY );
87
88{
89    no warnings 'once';
90    ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
91}
92
93open STDIN, 'Io_argv1.tmp' or die $!;
94@ARGV = ();
95ok( !eof(),     'STDIN has something' );
96
97is( <>, "ok 7\n" );
98
99SKIP: {
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
115SKIP: {
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
136fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" );
137open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!";
138print OUT "foo";
139close OUT;
140open IN, "Io_argv3.tmp" or die "Can't open temp file: $!";
141*ARGV = *IN;
142while (<>) {
143    print;
144    print "bar" if eof();
145}
146close IN;
147unlink "Io_argv3.tmp";
148**PROG**
149
150# This used to fail an assertion.
151# The tricks with *x and $x are to make PL_argvgv point to a freed SV when
152# the readline op does SvREFCNT_inc on it.  undef *x clears the scalar slot
153# ++$x vivifies it, reusing the just-deleted GV that PL_argvgv still points
154# to.  The BEGIN block ensures it is freed late enough that nothing else
155# has reused it yet.
156is runperl(prog => 'undef *x; delete $::{ARGV}; $x++;'
157                  .'eval q-BEGIN{undef *x} readline-; print qq-ok\n-'),
158  "ok\n", 'deleting $::{ARGV}';
159
160END {
161    unlink_all 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
162	'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';
163}
164