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