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