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 'io' ;
 214 my $file = "./xcv" ; unlink $file ;
 215 open (FH, ">$file") or die $! ;
 216 my $a = <FH> ;
 217 no warnings 'io' ;
 218 $a = <FH> ;
 219 use warnings 'io' ;
 220 open(FOO, ">&FH") or die $! ;
 221 $a = <FOO> ;
 222 no warnings 'io' ;
 223 $a = <FOO> ;
 224 use warnings 'io' ;
 225 $a = <FOO> ;
 226 $a = <FH> ;
 227 close (FH) or die $! ;
 228 close (FOO) or die $! ;
 229 unlink $file ;
 230 EXPECT
 231 Filehandle FH opened only for output at - line 5.
 232 Filehandle FOO opened only for output at - line 10.
 233 Filehandle FOO opened only for output at - line 14.
 234 Filehandle FH opened only for output at - line 15.
 235 ########
 236 # pp_hot.c [Perl_sub_crush_depth]
 237 use warnings 'recursion' ;
 238 sub fred
 239 {
 240     fred() if $a++ < 200
 241 }
 242 {
 243   local $SIG{__WARN__} = sub {
 244     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 245   };
 246   fred();
 247 }
 248 EXPECT
 249 ok
 250 ########
 251 # pp_hot.c [Perl_sub_crush_depth]
 252 no warnings 'recursion' ;
 253 sub fred
 254 {
 255     fred() if $a++ < 200
 256 }
 257 {
 258   local $SIG{__WARN__} = sub {
 259     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 260   };
 261   fred();
 262 }
 263 EXPECT
 264
 265 ########
 266 # pp_hot.c [Perl_sub_crush_depth]
 267 use warnings 'recursion' ;
 268 $b = sub
 269 {
 270     &$b if $a++ < 200
 271 }  ;
 272
 273 &$b ;
 274 EXPECT
 275 Deep recursion on anonymous subroutine at - line 5.
 276 ########
 277 # pp_hot.c [Perl_sub_crush_depth]
 278 no warnings 'recursion' ;
 279 $b = sub
 280 {
 281     &$b if $a++ < 200
 282 }  ;
 283
 284 &$b ;
 285 EXPECT
 286 ########
 287 # pp_hot.c [pp_concat]
 288 use warnings 'uninitialized';
 289 my($x, $y);
 290 sub a { shift }
 291 a($x . "x");    # should warn once
 292 a($x . $y);     # should warn twice
 293 $x .= $y;       # should warn once
 294 $y .= $y;       # should warn once
 295 EXPECT
 296 Use of uninitialized value $x in concatenation (.) or string at - line 5.
 297 Use of uninitialized value $x in concatenation (.) or string at - line 6.
 298 Use of uninitialized value $y in concatenation (.) or string at - line 6.
 299 Use of uninitialized value $y in concatenation (.) or string at - line 7.
 300 Use of uninitialized value $y in concatenation (.) or string at - line 8.
 301 ########
 302 # pp_hot.c [pp_aelem]
 303 {
 304 use warnings 'misc';
 305 print $x[\1];
 306 }
 307 {
 308 no warnings 'misc';
 309 print $x[\1];
 310 }
 311
 312 EXPECT
 313 OPTION regex
 314 Use of reference ".*" as array index at - line 4.
 315 ########
 316 # pp_hot.c [pp_aelem]
 317 package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
 318 $b = {};
 319 {
 320 use warnings 'misc';
 321 print $x[$a];
 322 print $x[$b];
 323 }
 324 {
 325 no warnings 'misc';
 326 print $x[$a];
 327 print $x[$b];
 328 }
 329
 330 EXPECT
 331 OPTION regex
 332 Use of reference ".*" as array index at - line 7.