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 close (FH) ;
 155 unlink $file ;
 156 EXPECT
 157 Filehandle FH opened only for output at - line 5.
 158 ########
 159 # pp_hot.c [Perl_sub_crush_depth]
 160 use warnings 'recursion' ;
 161 sub fred
 162 {
 163     fred() if $a++ < 200
 164 }
 165 {
 166   local $SIG{__WARN__} = sub {
 167     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 168   };
 169   fred();
 170 }
 171 EXPECT
 172 ok
 173 ########
 174 # pp_hot.c [Perl_sub_crush_depth]
 175 no warnings 'recursion' ;
 176 sub fred
 177 {
 178     fred() if $a++ < 200
 179 }
 180 {
 181   local $SIG{__WARN__} = sub {
 182     die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
 183   };
 184   fred();
 185 }
 186 EXPECT
 187
 188 ########
 189 # pp_hot.c [Perl_sub_crush_depth]
 190 use warnings 'recursion' ;
 191 $b = sub
 192 {
 193     &$b if $a++ < 200
 194 }  ;
 195
 196 &$b ;
 197 EXPECT
 198 Deep recursion on anonymous subroutine at - line 5.
 199 ########
 200 # pp_hot.c [Perl_sub_crush_depth]
 201 no warnings 'recursion' ;
 202 $b = sub
 203 {
 204     &$b if $a++ < 200
 205 }  ;
 206
 207 &$b ;
 208 EXPECT
 209 ########
 210 # pp_hot.c [pp_concat]
 211 use warnings 'y2k';
 212 use Config;
 213 BEGIN {
 214     unless ($Config{ccflags} =~ /Y2KWARN/) {
 215         print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
 216         exit 0;
 217     }
 218 }
 219 my $x;
 220 my $yy = 78;
 221 $x     = "19$yy\n";
 222 $x     = "19" . $yy . "\n";
 223 $x     = "319$yy\n";
 224 $x     = "319" . $yy . "\n";
 225 no warnings 'y2k';
 226 $x     = "19$yy\n";
 227 $x     = "19" . $yy . "\n";
 228 EXPECT
 229 Possible Y2K bug: about to append an integer to '19' at - line 12.
 230 Possible Y2K bug: about to append an integer to '19' at - line 13.