This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Improve rcatline bad fh warnings
[perl5.git] / t / lib / warnings / pp_hot
1   pp_hot.c      
2
3   print() on unopened filehandle abc            [pp_print]
4     $f = $a = "abc" ; print $f $a
5
6   Filehandle %s opened only for input           [pp_print]
7     print STDIN "abc" ;
8
9   Filehandle %s opened only for output          [pp_print]
10     $a = <STDOUT> ;
11
12   print() on closed filehandle %s               [pp_print]
13     close STDIN ; print STDIN "abc" ;
14
15   uninitialized                                 [pp_rv2av]
16         my $a = undef ; my @b = @$a
17
18   uninitialized                                 [pp_rv2hv]
19         my $a = undef ; my %b = %$a
20
21   Odd number of elements in hash list           [pp_aassign]
22         %X = (1,2,3) ;
23
24   Reference found where even-sized list expected [pp_aassign]
25         $X = [ 1 ..3 ];
26
27   Filehandle %s opened only for output          [Perl_do_readline] 
28         open (FH, ">./xcv") ;
29         my $a = <FH> ;
30
31   glob failed (can't start child: %s)           [Perl_do_readline] <<TODO
32
33   readline() on closed filehandle %s            [Perl_do_readline]
34     close STDIN ; $a = <STDIN>;
35
36   readline() on closed filehandle %s            [Perl_do_readline]
37     readline(NONESUCH);
38
39   glob failed (child exited with status %d%s)   [Perl_do_readline] <<TODO
40
41   Deep recursion on subroutine \"%s\"           [Perl_sub_crush_depth]
42     sub fred { fred() if $a++ < 200} fred()
43
44   Deep recursion on anonymous subroutine        [Perl_sub_crush_depth]
45     $a = sub { &$a if $a++ < 200} &$a
46
47   Use of reference "%s" as array index [pp_aelem]
48     $x[\1]
49
50 __END__
51 # pp_hot.c [pp_print]
52 use warnings 'unopened' ;
53 $f = $a = "abc" ; 
54 print $f $a;
55 no warnings 'unopened' ;
56 print $f $a;
57 use warnings;
58 no warnings 'unopened' ;
59 print $f $a;
60 EXPECT
61 print() on unopened filehandle abc at - line 4.
62 ########
63 # pp_hot.c [pp_print]
64 use warnings 'unopened' ;
65 $SIG{__WARN__} = sub { warn $_[0] =~ s/\0/\\0/rug; };
66 print {"a\0b"} "anc";
67 print {"\0b"} "anc";
68 EXPECT
69 print() on unopened filehandle a\0b at - line 4.
70 print() on unopened filehandle \0b at - line 5.
71 ########
72 # pp_hot.c [pp_print]
73 use warnings 'io' ;
74 # There is no guarantee that STDOUT is output only, or STDIN input only.
75 # Certainly on some BSDs (at least FreeBSD, Darwin, BSDi) file descriptors
76 # 1 and 2 are opened read/write on the tty, and the IO layers may reflect this.
77 # So we must make our own file handle that is read only.
78 my $file = "./xcv" ; unlink $file ;
79 open (FH, ">$file") or die $! ;
80 close FH or die $! ;
81 die "There is no file $file" unless -f $file ;
82 open (FH, "<$file") or die $! ;
83 print FH "anc" ;
84 open(FOO, "<&FH") or die $! ;
85 print FOO "anc" ;
86 no warnings 'io' ;
87 print FH "anc" ;
88 print FOO "anc" ;
89 use warnings 'io' ;
90 print FH "anc" ;
91 print FOO "anc" ;
92 close (FH) or die $! ;
93 close (FOO) or die $! ;
94 unlink $file ;
95 EXPECT
96 Filehandle FH opened only for input at - line 12.
97 Filehandle FOO opened only for input at - line 14.
98 Filehandle FH opened only for input at - line 19.
99 Filehandle FOO opened only for input at - line 20.
100 ########
101 # pp_hot.c [pp_print]
102 $SIG{__WARN__} = sub { warn $_[0] =~ s/\0/\\0/rug; };
103 use warnings 'io' ;
104 my $file = "./xcv" ; unlink $file ;
105 open (FH, ">$file") or die $! ;
106 close FH or die $! ;
107 die "There is no file $file" unless -f $file ;
108 open ("a\0b", "<$file") or die $! ;
109 print {"a\0b"} "anc" ;
110 open ("\0b", "<$file") or die $! ;
111 print {"\0b"} "anc" ;
112 close "a\0b" or die $! ;
113 close "\0b" or die $! ;
114 unlink $file ;
115 EXPECT
116 Filehandle a\0b opened only for input at - line 9.
117 Filehandle \0b opened only for input at - line 11.
118 ########
119 # pp_hot.c [pp_print]
120 use warnings 'closed' ;
121 close STDIN ;
122 print STDIN "anc";
123 opendir STDIN, ".";
124 print STDIN "anc";
125 closedir STDIN;
126 no warnings 'closed' ;
127 print STDIN "anc";
128 opendir STDIN, ".";
129 print STDIN "anc";
130 use warnings;
131 no warnings 'closed' ;
132 print STDIN "anc";
133 EXPECT
134 print() on closed filehandle STDIN at - line 4.
135 print() on closed filehandle STDIN at - line 6.
136         (Are you trying to call print() on dirhandle STDIN?)
137 ########
138 # pp_hot.c [pp_print]
139 # [ID 20020425.012] from Dave Steiner <steiner@bakerst.rutgers.edu>
140 # This goes segv on 5.7.3
141 use warnings 'closed' ;
142 my $fh = *STDOUT{IO};
143 close STDOUT or die "Can't close STDOUT";
144 print $fh "Shouldn't print anything, but shouldn't SEGV either\n";
145 EXPECT
146 print() on closed filehandle __ANONIO__ at - line 7.
147 ########
148 # pp_hot.c [pp_print]
149 package foo;
150 use warnings 'closed';
151 open my $fh1, "nonexistent";
152 print $fh1 42;
153 open $fh2, "nonexistent";
154 print $fh2 42;
155 open $bar::fh3, "nonexistent";
156 print $bar::fh3 42;
157 open bar::FH4, "nonexistent";
158 print bar::FH4 42;
159 EXPECT
160 print() on closed filehandle $fh1 at - line 5.
161 print() on closed filehandle $fh2 at - line 7.
162 print() on closed filehandle $fh3 at - line 9.
163 print() on closed filehandle FH4 at - line 11.
164 ########
165 # pp_hot.c [pp_rv2av]
166 use warnings 'uninitialized' ;
167 my $a = undef ;
168 my @b = @$a;
169 no warnings 'uninitialized' ;
170 my @c = @$a;
171 EXPECT
172 Use of uninitialized value $a in array dereference at - line 4.
173 ########
174 # pp_hot.c [pp_rv2hv]
175 use warnings 'uninitialized' ;
176 my $a = undef ;
177 my %b = %$a;
178 no warnings 'uninitialized' ;
179 my %c = %$a;
180 EXPECT
181 Use of uninitialized value $a in hash dereference at - line 4.
182 ########
183 # pp_hot.c [pp_aassign]
184 use warnings 'misc' ;
185 my %X ; %X = (1,2,3) ;
186 no warnings 'misc' ;
187 my %Y ; %Y = (1,2,3) ;
188 EXPECT
189 Odd number of elements in hash assignment at - line 3.
190 ########
191 # pp_hot.c [pp_aassign]
192 use warnings 'misc' ;
193 my %X ; %X = [1 .. 3] ;
194 no warnings 'misc' ;
195 my %Y ; %Y = [1 .. 3] ;
196 EXPECT
197 Reference found where even-sized list expected at - line 3.
198 ########
199 # pp_hot.c [Perl_do_readline]
200 use warnings 'closed' ;
201 close STDIN        ; $a = <STDIN> ;
202 opendir STDIN, "." ; $a = <STDIN> ;
203 closedir STDIN;
204 no warnings 'closed' ;
205 opendir STDIN, "." ; $a = <STDIN> ;
206 $a = <STDIN> ;
207 EXPECT
208 readline() on closed filehandle STDIN at - line 3.
209 readline() on closed filehandle STDIN at - line 4.
210         (Are you trying to call readline() on dirhandle STDIN?)
211 ########
212 # pp_hot.c [Perl_do_readline]
213 use warnings 'closed' ;
214 close STDIN        ; $a .= <STDIN> ;
215 opendir STDIN, "." ; $a .= <STDIN> ;
216 closedir STDIN;
217 no warnings 'closed' ;
218 opendir STDIN, "." ; $a .= <STDIN> ;
219 $a = <STDIN> ;
220 EXPECT
221 readline() on closed filehandle STDIN at - line 3.
222 readline() on closed filehandle STDIN at - line 4.
223         (Are you trying to call readline() on dirhandle STDIN?)
224 ########
225 # pp_hot.c [Perl_do_readline]
226 use warnings 'io' ;
227 my $file = "./xcv" ; unlink $file ;
228 open (FH, ">$file") or die $! ;
229 my $a = <FH> ;
230 no warnings 'io' ;
231 $a = <FH> ;
232 use warnings 'io' ;
233 open(FOO, ">&FH") or die $! ;
234 $a = <FOO> ;
235 no warnings 'io' ;
236 $a = <FOO> ;
237 use warnings 'io' ;
238 $a = <FOO> ;
239 $a = <FH> ;
240 close (FH) or die $! ;
241 close (FOO) or die $! ;
242 unlink $file ;
243 EXPECT
244 Filehandle FH opened only for output at - line 5.
245 Filehandle FOO opened only for output at - line 10.
246 Filehandle FOO opened only for output at - line 14.
247 Filehandle FH opened only for output at - line 15.
248 ########
249 # pp_hot.c [Perl_sub_crush_depth]
250 use warnings 'recursion' ;
251 sub fred 
252
253     fred() if $a++ < 200
254
255 {
256   local $SIG{__WARN__} = sub {
257     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
258   };
259   fred();
260 }
261 EXPECT
262 ok
263 ########
264 # pp_hot.c [Perl_sub_crush_depth]
265 no warnings 'recursion' ;
266 sub fred 
267
268     fred() if $a++ < 200
269
270 {
271   local $SIG{__WARN__} = sub {
272     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
273   };
274   fred();
275 }
276 EXPECT
277
278 ########
279 # pp_hot.c [Perl_sub_crush_depth]
280 use warnings 'recursion' ;
281 $b = sub 
282
283     &$b if $a++ < 200
284 }  ;
285
286 &$b ;
287 EXPECT
288 Deep recursion on anonymous subroutine at - line 5.
289 ########
290 # pp_hot.c [Perl_sub_crush_depth]
291 no warnings 'recursion' ;
292 $b = sub 
293
294     &$b if $a++ < 200
295 }  ;
296
297 &$b ;
298 EXPECT
299 ########
300 # pp_hot.c [pp_concat]
301 use warnings 'uninitialized';
302 my($x, $y);
303 sub a { shift }
304 a($x . "x");    # should warn once
305 a($x . $y);     # should warn twice
306 $x .= $y;       # should warn once
307 $y .= $y;       # should warn once
308 EXPECT
309 Use of uninitialized value $x in concatenation (.) or string at - line 5.
310 Use of uninitialized value $x in concatenation (.) or string at - line 6.
311 Use of uninitialized value $y in concatenation (.) or string at - line 6.
312 Use of uninitialized value $y in concatenation (.) or string at - line 7.
313 Use of uninitialized value $y in concatenation (.) or string at - line 8.
314 ########
315 # pp_hot.c [pp_aelem]
316 {
317 use warnings 'misc';
318 print $x[\1];
319 }
320 {
321 no warnings 'misc';
322 print $x[\1];
323 }
324
325 EXPECT
326 OPTION regex
327 Use of reference ".*" as array index at - line 4.
328 ########
329 # pp_hot.c [pp_aelem]
330 package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
331 $b = {};
332 {
333 use warnings 'misc';
334 print $x[$a];
335 print $x[$b];
336 }
337 {
338 no warnings 'misc';
339 print $x[$a];
340 print $x[$b];
341 }
342
343 EXPECT
344 OPTION regex
345 Use of reference ".*" as array index at - line 7.