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