t/pragma/warn/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 __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 EXPECT
  58 print() on unopened filehandle abc at - line 4.
  59 ########
  60 # pp_hot.c [pp_print]
  61 use warnings 'io' ;
  62 print STDIN "anc";
  63 print <STDOUT>;
  64 print <STDERR>;
  65 open(FOO, ">&STDOUT") and print <FOO>;
  66 print getc(STDERR);
  67 print getc(FOO);
  68 ####################################################################
  69 # The next test is known to fail on some systems (Linux+old glibc, #
  70 # old *BSDs, and NeXT, among others.                               #
  71 # We skip it for now (on the grounds that it is "just" a warning). #
  72 ####################################################################
  73 #read(FOO,$_,1);
  74 no warnings 'io' ;
  75 print STDIN "anc";
  76 EXPECT
  77 Filehandle STDIN opened only for input at - line 3.
  78 Filehandle STDOUT opened only for output at - line 4.
  79 Filehandle STDERR opened only for output at - line 5.
  80 Filehandle FOO opened only for output at - line 6.
  81 Filehandle STDERR opened only for output at - line 7.
  82 Filehandle FOO opened only for output at - line 8.
  83 ########
  84 # pp_hot.c [pp_print]
  85 use warnings 'closed' ;
  86 close STDIN ;
  87 print STDIN "anc";
  88 opendir STDIN, ".";
  89 print STDIN "anc";
  90 closedir STDIN;
  91 no warnings 'closed' ;
  92 print STDIN "anc";
  93 opendir STDIN, ".";
  94 print STDIN "anc";
  95 EXPECT
  96 print() on closed filehandle STDIN at - line 4.
  97 print() on closed filehandle STDIN at - line 6.
  98         (Are you trying to call print() on dirhandle STDIN?)
  99 ########
 100 # pp_hot.c [pp_rv2av]
 101 use warnings 'uninitialized' ;
 102 my $a = undef ;
 103 my @b = @$a;
 104 no warnings 'uninitialized' ;
 105 my @c = @$a;
 106 EXPECT
 107 Use of uninitialized value in array dereference at - line 4.
 108 ########
 109 # pp_hot.c [pp_rv2hv]
 110 use warnings 'uninitialized' ;
 111 my $a = undef ;
 112 my %b = %$a;
 113 no warnings 'uninitialized' ;
 114 my %c = %$a;
 115 EXPECT
 116 Use of uninitialized value in hash dereference at - line 4.
 117 ########
 118 # pp_hot.c [pp_aassign]
 119 use warnings 'misc' ;
 120 my %X ; %X = (1,2,3) ;
 121 no warnings 'misc' ;
 122 my %Y ; %Y = (1,2,3) ;
 123 EXPECT
 124 Odd number of elements in hash assignment at - line 3.
 125 ########
 126 # pp_hot.c [pp_aassign]
 127 use warnings 'misc' ;
 128 my %X ; %X = [1 .. 3] ;
 129 no warnings 'misc' ;
 130 my %Y ; %Y = [1 .. 3] ;
 131 EXPECT
 132 Reference found where even-sized list expected at - line 3.
 133 ########
 134 # pp_hot.c [Perl_do_readline]
 135 use warnings 'closed' ;
 136 close STDIN        ; $a = <STDIN> ;
 137 opendir STDIN, "." ; $a = <STDIN> ;
 138 closedir STDIN;
 139 no warnings 'closed' ;
 140 opendir STDIN, "." ; $a = <STDIN> ;
 141 $a = <STDIN> ;
 142 EXPECT
 143 readline() on closed filehandle STDIN at - line 3.
 144 readline() on closed filehandle STDIN at - line 4.
 145         (Are you trying to call readline() on dirhandle STDIN?)
 146 ########
 147 # pp_hot.c [Perl_do_readline]
 148 use warnings 'io' ;
 149 my $file = "./xcv" ; unlink $file ;
 150 open (FH, ">./xcv") ;
 151 my $a = <FH> ;
 152 no warnings 'io' ;
 153 $a = <FH> ;
 154 unlink $file ;
 155 EXPECT
 156 Filehandle FH opened only for output at - line 5.
 157 ########
 158 # pp_hot.c [Perl_sub_crush_depth]
 159 use warnings 'recursion' ;
 160 sub fred
 161 {
 162     fred() if $a++ < 200
 163 }
 164 {
 165   local $SIG{__WARN__} = sub {
 166     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 167   };
 168   fred();
 169 }
 170 EXPECT
 171 ok
 172 ########
 173 # pp_hot.c [Perl_sub_crush_depth]
 174 no warnings 'recursion' ;
 175 sub fred
 176 {
 177     fred() if $a++ < 200
 178 }
 179 {
 180   local $SIG{__WARN__} = sub {
 181     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 182   };
 183   fred();
 184 }
 185 EXPECT
 186
 187 ########
 188 # pp_hot.c [Perl_sub_crush_depth]
 189 use warnings 'recursion' ;
 190 $b = sub
 191 {
 192     &$b if $a++ < 200
 193 }  ;
 194
 195 &$b ;
 196 EXPECT
 197 Deep recursion on anonymous subroutine at - line 5.
 198 ########
 199 # pp_hot.c [Perl_sub_crush_depth]
 200 no warnings 'recursion' ;
 201 $b = sub
 202 {
 203     &$b if $a++ < 200
 204 }  ;
 205
 206 &$b ;
 207 EXPECT
 208 ########
 209 # pp_hot.c [pp_concat]
 210 use warnings 'y2k';
 211 use Config;
 212 BEGIN {
 213     unless ($Config{ccflags} =~ /Y2KWARN/) {
 214         print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
 215         exit 0;
 216     }
 217 }
 218 my $x;
 219 my $yy = 78;
 220 $x     = "19$yy\n";
 221 $x     = "19" . $yy . "\n";
 222 $x     = "319$yy\n";
 223 $x     = "319" . $yy . "\n";
 224 no warnings 'y2k';
 225 $x     = "19$yy\n";
 226 $x     = "19" . $yy . "\n";
 227 EXPECT
 228 Possible Y2K bug: about to append an integer to '19' at - line 12.
 229 Possible Y2K bug: about to append an integer to '19' at - line 13.