t/pragma/warn/pp_hot

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