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.
 346 ########
 347 use warnings 'misc';
 348 use constant FOO => { a => 1 };
 349 () = $_[FOO->{a}];
 350
 351 EXPECT
 352 ########
 353 use warnings 'misc';
 354 use constant FOO => {};
 355 () = $_[FOO];
 356
 357 EXPECT
 358 OPTION regex
 359 Use of reference "HASH\(0x\w+\)" as array index at - line 3.