Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
820475bd GS |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
624c42e2 N |
5 | require "./test.pl"; |
6 | set_up_inc('../lib'); | |
820475bd GS |
7 | } |
8 | ||
0f6f92e0 | 9 | plan(tests => 37); |
820475bd | 10 | |
8594e3bf | 11 | my ($devnull, $no_devnull); |
820475bd | 12 | |
8594e3bf NC |
13 | if (is_miniperl()) { |
14 | $no_devnull = "no dynamic loading on miniperl, File::Spec not built, so can't determine /dev/null"; | |
15 | } else { | |
16 | require File::Spec; | |
17 | $devnull = File::Spec->devnull; | |
18 | } | |
8d063cd8 | 19 | |
7d932aad MS |
20 | open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!"); |
21 | print TRY "a line\n"; | |
d1e4d418 | 22 | close TRY or die "Could not close: $!"; |
c6f54c1d RGS |
23 | open(TRY, '>Io_argv2.tmp') || (die "Can't open temp file: $!"); |
24 | print TRY "another line\n"; | |
25 | close TRY or die "Could not close: $!"; | |
8d063cd8 | 26 | |
137352a2 RGS |
27 | $x = runperl( |
28 | prog => 'while (<>) { print $., $_; }', | |
29 | args => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ], | |
30 | ); | |
7d932aad | 31 | is($x, "1a line\n2a line\n", '<> from two files'); |
8d063cd8 | 32 | |
7d932aad | 33 | { |
137352a2 RGS |
34 | $x = runperl( |
35 | prog => 'while (<>) { print $_; }', | |
36 | stdin => "foo\n", | |
37 | args => [ 'Io_argv1.tmp', '-' ], | |
38 | ); | |
7889afd0 | 39 | is($x, "a line\nfoo\n", '<> from a file and STDIN'); |
8d063cd8 | 40 | |
0f6f92e0 RGS |
41 | # readline should behave as <>, not <<>> |
42 | $x = runperl( | |
43 | prog => 'while (readline) { print $_; }', | |
44 | stdin => "foo\n", | |
45 | stderr => 1, | |
46 | args => [ '-' ], | |
47 | ); | |
48 | is($x, "foo\n", 'readline() from STDIN'); | |
49 | ||
137352a2 RGS |
50 | $x = runperl( |
51 | prog => 'while (<>) { print $_; }', | |
52 | stdin => "foo\n", | |
53 | ); | |
7889afd0 | 54 | is($x, "foo\n", '<> from just STDIN'); |
c6f54c1d RGS |
55 | |
56 | $x = runperl( | |
57 | prog => 'while (<>) { print $ARGV.q/,/.$_ }', | |
58 | args => [ 'Io_argv1.tmp', 'Io_argv2.tmp' ], | |
59 | ); | |
60 | is($x, "Io_argv1.tmp,a line\nIo_argv2.tmp,another line\n", '$ARGV is the file name'); | |
61 | ||
d1313cbe CB |
62 | TODO: { |
63 | local $::TODO = "unrelated bug in redirection implementation" if $^O eq 'VMS'; | |
64 | $x = runperl( | |
65 | prog => 'print $ARGV while <>', | |
66 | stdin => "foo\nbar\n", | |
67 | args => [ '-' ], | |
68 | ); | |
69 | is($x, "--", '$ARGV is - for explicit STDIN'); | |
70 | ||
71 | $x = runperl( | |
72 | prog => 'print $ARGV while <>', | |
73 | stdin => "foo\nbar\n", | |
74 | ); | |
75 | is($x, "--", '$ARGV is - for implicit STDIN'); | |
76 | } | |
2986a63f | 77 | } |
8d063cd8 | 78 | |
1e1d4b91 JJ |
79 | { |
80 | # 5.10 stopped autovivifying scalars in globs leading to a | |
81 | # segfault when $ARGV is written to. | |
82 | runperl( prog => 'eof()', stdin => "nothing\n" ); | |
83 | is( 0+$?, 0, q(eof() doesn't segfault) ); | |
84 | } | |
85 | ||
8594e3bf NC |
86 | @ARGV = is_miniperl() ? ('Io_argv1.tmp', 'Io_argv1.tmp', 'Io_argv1.tmp') |
87 | : ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp'); | |
8d063cd8 LW |
88 | while (<>) { |
89 | $y .= $. . $_; | |
378cc40b | 90 | if (eof()) { |
7d932aad | 91 | is($., 3, '$. counts <>'); |
8d063cd8 LW |
92 | } |
93 | } | |
94 | ||
7d932aad MS |
95 | is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV'); |
96 | ||
8d063cd8 | 97 | |
7d932aad | 98 | open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!"; |
d1e4d418 | 99 | close TRY or die "Could not close: $!"; |
7d932aad | 100 | open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!"; |
d1e4d418 | 101 | close TRY or die "Could not close: $!"; |
684bef36 | 102 | @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp'); |
7d932aad | 103 | $^I = '_bak'; # not .bak which confuses VMS |
fbad3eb5 | 104 | $/ = undef; |
0f6f92e0 | 105 | my $i = 11; |
fbad3eb5 | 106 | while (<>) { |
684bef36 GS |
107 | s/^/ok $i\n/; |
108 | ++$i; | |
fbad3eb5 | 109 | print; |
7d932aad | 110 | next_test(); |
fbad3eb5 | 111 | } |
7d932aad MS |
112 | open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!"; |
113 | print while <TRY>; | |
114 | open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!"; | |
115 | print while <TRY>; | |
d1e4d418 | 116 | close TRY or die "Could not close: $!"; |
820475bd GS |
117 | undef $^I; |
118 | ||
7d932aad | 119 | ok( eof TRY ); |
820475bd | 120 | |
1031ca5c SP |
121 | { |
122 | no warnings 'once'; | |
123 | ok( eof NEVEROPENED, 'eof() true on unopened filehandle' ); | |
124 | } | |
820475bd | 125 | |
684bef36 | 126 | open STDIN, 'Io_argv1.tmp' or die $!; |
820475bd | 127 | @ARGV = (); |
7d932aad | 128 | ok( !eof(), 'STDIN has something' ); |
820475bd | 129 | |
0f6f92e0 | 130 | is( <>, "ok 11\n" ); |
820475bd | 131 | |
8594e3bf NC |
132 | SKIP: { |
133 | skip_if_miniperl($no_devnull, 4); | |
134 | open STDIN, $devnull or die $!; | |
135 | @ARGV = (); | |
136 | ok( eof(), 'eof() true with empty @ARGV' ); | |
820475bd | 137 | |
8594e3bf NC |
138 | @ARGV = ('Io_argv1.tmp'); |
139 | ok( !eof() ); | |
820475bd | 140 | |
8594e3bf NC |
141 | @ARGV = ($devnull, $devnull); |
142 | ok( !eof() ); | |
820475bd | 143 | |
8594e3bf NC |
144 | close ARGV or die $!; |
145 | ok( eof(), 'eof() true after closing ARGV' ); | |
146 | } | |
684bef36 | 147 | |
8594e3bf | 148 | SKIP: { |
684bef36 | 149 | local $/; |
8594e3bf NC |
150 | open my $fh, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!"; |
151 | <$fh>; # set $. = 1 | |
152 | is( <$fh>, undef ); | |
153 | ||
154 | skip_if_miniperl($no_devnull, 5); | |
7d932aad | 155 | |
8594e3bf NC |
156 | open $fh, $devnull or die; |
157 | ok( defined(<$fh>) ); | |
7d932aad | 158 | |
8594e3bf NC |
159 | is( <$fh>, undef ); |
160 | is( <$fh>, undef ); | |
7d932aad | 161 | |
8594e3bf NC |
162 | open $fh, $devnull or die; # restart cycle again |
163 | ok( defined(<$fh>) ); | |
164 | is( <$fh>, undef ); | |
165 | close $fh or die "Could not close: $!"; | |
684bef36 | 166 | } |
fbad3eb5 | 167 | |
7889afd0 | 168 | open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!"); |
8710cf8f | 169 | print TRY "one\n\nthree\n"; |
7889afd0 RGS |
170 | close TRY or die "Could not close: $!"; |
171 | ||
172 | $x = runperl( | |
c6f54c1d | 173 | prog => 'print $..$ARGV.$_ while <<>>', |
7889afd0 RGS |
174 | args => [ 'Io_argv1.tmp' ], |
175 | ); | |
8710cf8f RGS |
176 | is($x, "1Io_argv1.tmpone\n2Io_argv1.tmp\n3Io_argv1.tmpthree\n", '<<>>'); |
177 | ||
178 | $x = runperl( | |
179 | prog => '$w=q/b/;$w.=<<>>;print $w', | |
180 | args => [ 'Io_argv1.tmp' ], | |
181 | ); | |
182 | is($x, "bone\n", '<<>> and rcatline'); | |
7889afd0 RGS |
183 | |
184 | $x = runperl( | |
185 | prog => 'while (<<>>) { print }', | |
186 | stdin => "foo\n", | |
187 | ); | |
188 | is($x, "foo\n", '<<>> from just STDIN (no argument)'); | |
189 | ||
d1313cbe CB |
190 | TODO: { |
191 | local $::TODO = "unrelated bug in redirection implementation" if $^O eq 'VMS'; | |
192 | $x = runperl( | |
193 | prog => 'print $ARGV.q/,/ for <<>>', | |
194 | stdin => "foo\nbar\n", | |
195 | ); | |
196 | is($x, "-,-,", '$ARGV is - for STDIN with <<>>'); | |
197 | } | |
c6f54c1d RGS |
198 | |
199 | $x = runperl( | |
7889afd0 RGS |
200 | prog => 'while (<<>>) { print $_; }', |
201 | stdin => "foo\n", | |
202 | stderr => 1, | |
203 | args => [ '-' ], | |
204 | ); | |
df968918 | 205 | like($x, qr/^Can't open -: .* at -e line 1/, '<<>> does not treat - as STDIN'); |
7889afd0 | 206 | |
ef32f9b9 RGS |
207 | { |
208 | # tests for an empty string in @ARGV | |
209 | $x = runperl( | |
210 | prog => 'push @ARGV,q//;print while <>', | |
211 | stderr => 1, | |
212 | ); | |
0f6f92e0 | 213 | like($x, qr/^Can't open : .* at -e line 1/, '<> does not open empty string in ARGV'); |
ef32f9b9 RGS |
214 | |
215 | $x = runperl( | |
216 | prog => 'push @ARGV,q//;print while <<>>', | |
217 | stderr => 1, | |
218 | ); | |
0f6f92e0 | 219 | like($x, qr/^Can't open : .* at -e line 1/, '<<>> does not open empty string in ARGV'); |
ef32f9b9 RGS |
220 | } |
221 | ||
7889afd0 | 222 | SKIP: { |
7f2ab31f | 223 | skip('no echo', 2) unless -x '/bin/echo'; |
7889afd0 RGS |
224 | |
225 | $x = runperl( | |
226 | prog => 'while (<<>>) { print $_; }', | |
227 | stderr => 1, | |
228 | args => [ '"echo foo |"' ], | |
229 | ); | |
df968918 | 230 | like($x, qr/^Can't open echo foo \|: .* at -e line 1/, '<<>> does not treat ...| as fork'); |
ad77c200 RGS |
231 | |
232 | $x = runperl( | |
233 | prog => 'while (<<>>) { }', | |
234 | stderr => 1, | |
235 | args => [ 'Io_argv1.tmp', '"echo foo |"' ], | |
236 | ); | |
df968918 | 237 | like($x, qr/^Can't open echo foo \|: .* at -e line 1, <> line 3/, '<<>> does not treat ...| as fork after eof'); |
7889afd0 RGS |
238 | } |
239 | ||
ed2c6b9b RGS |
240 | # This used to dump core |
241 | fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" ); | |
242 | open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!"; | |
243 | print OUT "foo"; | |
244 | close OUT; | |
245 | open IN, "Io_argv3.tmp" or die "Can't open temp file: $!"; | |
246 | *ARGV = *IN; | |
247 | while (<>) { | |
248 | print; | |
249 | print "bar" if eof(); | |
250 | } | |
251 | close IN; | |
252 | unlink "Io_argv3.tmp"; | |
253 | **PROG** | |
254 | ||
722fa0e9 FC |
255 | # This used to fail an assertion. |
256 | # The tricks with *x and $x are to make PL_argvgv point to a freed SV when | |
257 | # the readline op does SvREFCNT_inc on it. undef *x clears the scalar slot | |
258 | # ++$x vivifies it, reusing the just-deleted GV that PL_argvgv still points | |
259 | # to. The BEGIN block ensures it is freed late enough that nothing else | |
260 | # has reused it yet. | |
261 | is runperl(prog => 'undef *x; delete $::{ARGV}; $x++;' | |
262 | .'eval q-BEGIN{undef *x} readline-; print qq-ok\n-'), | |
263 | "ok\n", 'deleting $::{ARGV}'; | |
264 | ||
ed2c6b9b | 265 | END { |
4813d64b | 266 | unlink_all 'Io_argv1.tmp', 'Io_argv1.tmp_bak', |
ed2c6b9b RGS |
267 | 'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp'; |
268 | } |