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