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     print <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 print STDIN "anc";
  66 print <STDOUT>;
  67 print <STDERR>;
  68 open(FOO, ">&STDOUT") and print <FOO>;
  69 print getc(STDERR);
  70 print getc(FOO);
  71 ####################################################################
  72 # The next test is known to fail on some systems (Linux+old glibc, #
  73 # some *BSDs (including Mac OS X and NeXT), among others.          #
  74 # We skip it for now (on the grounds that it is "just" a warning). #
  75 ####################################################################
  76 #read(FOO,$_,1);
  77 no warnings 'io' ;
  78 print STDIN "anc";
  79 EXPECT
  80 Filehandle STDIN opened only for input at - line 3.
  81 Filehandle STDOUT opened only for output at - line 4.
  82 Filehandle STDERR opened only for output at - line 5.
  83 Filehandle FOO opened only for output at - line 6.
  84 Filehandle STDERR opened only for output at - line 7.
  85 Filehandle FOO opened only for output at - line 8.
  86 ########
  87 # pp_hot.c [pp_print]
  88 use warnings 'closed' ;
  89 close STDIN ;
  90 print STDIN "anc";
  91 opendir STDIN, ".";
  92 print STDIN "anc";
  93 closedir STDIN;
  94 no warnings 'closed' ;
  95 print STDIN "anc";
  96 opendir STDIN, ".";
  97 print STDIN "anc";
  98 EXPECT
  99 print() on closed filehandle STDIN at - line 4.
 100 print() on closed filehandle STDIN at - line 6.
 101         (Are you trying to call print() on dirhandle STDIN?)
 102 ########
 103 # pp_hot.c [pp_rv2av]
 104 use warnings 'uninitialized' ;
 105 my $a = undef ;
 106 my @b = @$a;
 107 no warnings 'uninitialized' ;
 108 my @c = @$a;
 109 EXPECT
 110 Use of uninitialized value in array dereference at - line 4.
 111 ########
 112 # pp_hot.c [pp_rv2hv]
 113 use warnings 'uninitialized' ;
 114 my $a = undef ;
 115 my %b = %$a;
 116 no warnings 'uninitialized' ;
 117 my %c = %$a;
 118 EXPECT
 119 Use of uninitialized value in hash dereference at - line 4.
 120 ########
 121 # pp_hot.c [pp_aassign]
 122 use warnings 'misc' ;
 123 my %X ; %X = (1,2,3) ;
 124 no warnings 'misc' ;
 125 my %Y ; %Y = (1,2,3) ;
 126 EXPECT
 127 Odd number of elements in hash assignment at - line 3.
 128 ########
 129 # pp_hot.c [pp_aassign]
 130 use warnings 'misc' ;
 131 my %X ; %X = [1 .. 3] ;
 132 no warnings 'misc' ;
 133 my %Y ; %Y = [1 .. 3] ;
 134 EXPECT
 135 Reference found where even-sized list expected at - line 3.
 136 ########
 137 # pp_hot.c [Perl_do_readline]
 138 use warnings 'closed' ;
 139 close STDIN        ; $a = <STDIN> ;
 140 opendir STDIN, "." ; $a = <STDIN> ;
 141 closedir STDIN;
 142 no warnings 'closed' ;
 143 opendir STDIN, "." ; $a = <STDIN> ;
 144 $a = <STDIN> ;
 145 EXPECT
 146 readline() on closed filehandle STDIN at - line 3.
 147 readline() on closed filehandle STDIN at - line 4.
 148         (Are you trying to call readline() on dirhandle STDIN?)
 149 ########
 150 # pp_hot.c [Perl_do_readline]
 151 use warnings 'io' ;
 152 my $file = "./xcv" ; unlink $file ;
 153 open (FH, ">./xcv") ;
 154 my $a = <FH> ;
 155 no warnings 'io' ;
 156 $a = <FH> ;
 157 close (FH) ;
 158 unlink $file ;
 159 EXPECT
 160 Filehandle FH opened only for output at - line 5.
 161 ########
 162 # pp_hot.c [Perl_sub_crush_depth]
 163 use warnings 'recursion' ;
 164 sub fred
 165 {
 166     fred() if $a++ < 200
 167 }
 168 {
 169   local $SIG{__WARN__} = sub {
 170     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 171   };
 172   fred();
 173 }
 174 EXPECT
 175 ok
 176 ########
 177 # pp_hot.c [Perl_sub_crush_depth]
 178 no warnings 'recursion' ;
 179 sub fred
 180 {
 181     fred() if $a++ < 200
 182 }
 183 {
 184   local $SIG{__WARN__} = sub {
 185     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 186   };
 187   fred();
 188 }
 189 EXPECT
 190
 191 ########
 192 # pp_hot.c [Perl_sub_crush_depth]
 193 use warnings 'recursion' ;
 194 $b = sub
 195 {
 196     &$b if $a++ < 200
 197 }  ;
 198
 199 &$b ;
 200 EXPECT
 201 Deep recursion on anonymous subroutine at - line 5.
 202 ########
 203 # pp_hot.c [Perl_sub_crush_depth]
 204 no warnings 'recursion' ;
 205 $b = sub
 206 {
 207     &$b if $a++ < 200
 208 }  ;
 209
 210 &$b ;
 211 EXPECT
 212 ########
 213 # pp_hot.c [pp_concat]
 214 use warnings 'uninitialized';
 215 my($x, $y);
 216 sub a { shift }
 217 a($x . "x");    # should warn once
 218 a($x . $y);     # should warn twice
 219 $x .= $y;       # should warn once
 220 $y .= $y;       # should warn once
 221 EXPECT
 222 Use of uninitialized value in concatenation (.) or string at - line 5.
 223 Use of uninitialized value in concatenation (.) or string at - line 6.
 224 Use of uninitialized value in concatenation (.) or string at - line 6.
 225 Use of uninitialized value in concatenation (.) or string at - line 7.
 226 Use of uninitialized value in concatenation (.) or string at - line 8.
 227 ########
 228 # pp_hot.c [pp_concat]
 229 use warnings 'y2k';
 230 use Config;
 231 BEGIN {
 232     unless ($Config{ccflags} =~ /Y2KWARN/) {
 233         print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
 234         exit 0;
 235     }
 236 }
 237 my $x;
 238 my $yy = 78;
 239 $x     = "19$yy\n";
 240 $x     = "19" . $yy . "\n";
 241 $x     = "319$yy\n";
 242 $x     = "319" . $yy . "\n";
 243 $yy = 19;
 244 $x     = "ok $yy\n";
 245 $yy = 9;
 246 $x     = 1 . $yy;
 247 no warnings 'y2k';
 248 $x     = "19$yy\n";
 249 $x     = "19" . $yy . "\n";
 250 EXPECT
 251 Possible Y2K bug: about to append an integer to '19' at - line 12.
 252 Possible Y2K bug: about to append an integer to '19' at - line 13.
 253 ########
 254 # pp_hot.c [pp_aelem]
 255 {
 256 use warnings 'misc';
 257 print $x[\1];
 258 }
 259 {
 260 no warnings 'misc';
 261 print $x[\1];
 262 }
 263
 264 EXPECT
 265 OPTION regex
 266 Use of reference ".*" as array index at - line 4.
 267 ########
 268 # pp_hot.c [pp_aelem]
 269 package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
 270 $b = {};
 271 {
 272 use warnings 'misc';
 273 print $x[$a];
 274 print $x[$b];
 275 }
 276 {
 277 no warnings 'misc';
 278 print $x[$a];
 279 print $x[$b];
 280 }
 281
 282 EXPECT
 283 OPTION regex
 284 Use of reference ".*" as array index at - line 7.