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_rv2av]
 119 use warnings 'uninitialized' ;
 120 my $a = undef ;
 121 my @b = @$a;
 122 no warnings 'uninitialized' ;
 123 my @c = @$a;
 124 EXPECT
 125 Use of uninitialized value in array dereference at - line 4.
 126 ########
 127 # pp_hot.c [pp_rv2hv]
 128 use warnings 'uninitialized' ;
 129 my $a = undef ;
 130 my %b = %$a;
 131 no warnings 'uninitialized' ;
 132 my %c = %$a;
 133 EXPECT
 134 Use of uninitialized value in hash dereference at - line 4.
 135 ########
 136 # pp_hot.c [pp_aassign]
 137 use warnings 'misc' ;
 138 my %X ; %X = (1,2,3) ;
 139 no warnings 'misc' ;
 140 my %Y ; %Y = (1,2,3) ;
 141 EXPECT
 142 Odd number of elements in hash assignment at - line 3.
 143 ########
 144 # pp_hot.c [pp_aassign]
 145 use warnings 'misc' ;
 146 my %X ; %X = [1 .. 3] ;
 147 no warnings 'misc' ;
 148 my %Y ; %Y = [1 .. 3] ;
 149 EXPECT
 150 Reference found where even-sized list expected at - line 3.
 151 ########
 152 # pp_hot.c [Perl_do_readline]
 153 use warnings 'closed' ;
 154 close STDIN        ; $a = <STDIN> ;
 155 opendir STDIN, "." ; $a = <STDIN> ;
 156 closedir STDIN;
 157 no warnings 'closed' ;
 158 opendir STDIN, "." ; $a = <STDIN> ;
 159 $a = <STDIN> ;
 160 EXPECT
 161 readline() on closed filehandle STDIN at - line 3.
 162 readline() on closed filehandle STDIN at - line 4.
 163         (Are you trying to call readline() on dirhandle STDIN?)
 164 ########
 165 # pp_hot.c [Perl_do_readline]
 166 use warnings 'io' ;
 167 my $file = "./xcv" ; unlink $file ;
 168 open (FH, ">$file") or die $! ;
 169 my $a = <FH> ;
 170 no warnings 'io' ;
 171 $a = <FH> ;
 172 use warnings 'io' ;
 173 open(FOO, ">&FH") or die $! ;
 174 $a = <FOO> ;
 175 no warnings 'io' ;
 176 $a = <FOO> ;
 177 use warnings 'io' ;
 178 $a = <FOO> ;
 179 $a = <FH> ;
 180 close (FH) or die $! ;
 181 close (FOO) or die $! ;
 182 unlink $file ;
 183 EXPECT
 184 Filehandle FH opened only for output at - line 5.
 185 Filehandle FOO opened only for output at - line 10.
 186 Filehandle FOO opened only for output at - line 14.
 187 Filehandle FH opened only for output at - line 15.
 188 ########
 189 # pp_hot.c [Perl_sub_crush_depth]
 190 use warnings 'recursion' ;
 191 sub fred
 192 {
 193     fred() if $a++ < 200
 194 }
 195 {
 196   local $SIG{__WARN__} = sub {
 197     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 198   };
 199   fred();
 200 }
 201 EXPECT
 202 ok
 203 ########
 204 # pp_hot.c [Perl_sub_crush_depth]
 205 no warnings 'recursion' ;
 206 sub fred
 207 {
 208     fred() if $a++ < 200
 209 }
 210 {
 211   local $SIG{__WARN__} = sub {
 212     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 213   };
 214   fred();
 215 }
 216 EXPECT
 217
 218 ########
 219 # pp_hot.c [Perl_sub_crush_depth]
 220 use warnings 'recursion' ;
 221 $b = sub
 222 {
 223     &$b if $a++ < 200
 224 }  ;
 225
 226 &$b ;
 227 EXPECT
 228 Deep recursion on anonymous subroutine at - line 5.
 229 ########
 230 # pp_hot.c [Perl_sub_crush_depth]
 231 no warnings 'recursion' ;
 232 $b = sub
 233 {
 234     &$b if $a++ < 200
 235 }  ;
 236
 237 &$b ;
 238 EXPECT
 239 ########
 240 # pp_hot.c [pp_concat]
 241 use warnings 'uninitialized';
 242 my($x, $y);
 243 sub a { shift }
 244 a($x . "x");    # should warn once
 245 a($x . $y);     # should warn twice
 246 $x .= $y;       # should warn once
 247 $y .= $y;       # should warn once
 248 EXPECT
 249 Use of uninitialized value in concatenation (.) or string at - line 5.
 250 Use of uninitialized value in concatenation (.) or string at - line 6.
 251 Use of uninitialized value in concatenation (.) or string at - line 6.
 252 Use of uninitialized value in concatenation (.) or string at - line 7.
 253 Use of uninitialized value in concatenation (.) or string at - line 8.
 254 ########
 255 # pp_hot.c [pp_concat]
 256 use warnings 'y2k';
 257 use Config;
 258 BEGIN {
 259     unless ($Config{ccflags} =~ /Y2KWARN/) {
 260         print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
 261         exit 0;
 262     }
 263 }
 264 my $x;
 265 my $yy = 78;
 266 $x     = "19$yy\n";
 267 $x     = "19" . $yy . "\n";
 268 $x     = "319$yy\n";
 269 $x     = "319" . $yy . "\n";
 270 $yy = 19;
 271 $x     = "ok $yy\n";
 272 $yy = 9;
 273 $x     = 1 . $yy;
 274 no warnings 'y2k';
 275 $x     = "19$yy\n";
 276 $x     = "19" . $yy . "\n";
 277 EXPECT
 278 Possible Y2K bug: about to append an integer to '19' at - line 12.
 279 Possible Y2K bug: about to append an integer to '19' at - line 13.
 280 ########
 281 # pp_hot.c [pp_aelem]
 282 {
 283 use warnings 'misc';
 284 print $x[\1];
 285 }
 286 {
 287 no warnings 'misc';
 288 print $x[\1];
 289 }
 290
 291 EXPECT
 292 OPTION regex
 293 Use of reference ".*" as array index at - line 4.
 294 ########
 295 # pp_hot.c [pp_aelem]
 296 package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
 297 $b = {};
 298 {
 299 use warnings 'misc';
 300 print $x[$a];
 301 print $x[$b];
 302 }
 303 {
 304 no warnings 'misc';
 305 print $x[$a];
 306 print $x[$b];
 307 }
 308
 309 EXPECT
 310 OPTION regex
 311 Use of reference ".*" as array index at - line 7.