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