t/lib/warnings/pp_ctl

   1   pp_ctl.c      AOK
   2
   3      Not enough format arguments
   4         format STDOUT =
   5         @<<< @<<<
   6         $a
   7         .
   8         write;
   9
  10
  11     Exiting substitution via %s
  12         $_ = "abc" ;
  13         while ($i ++ == 0)
  14         {
  15             s/ab/last/e ;
  16         }
  17
  18     Exiting subroutine via %s
  19         sub fred { last }
  20         { fred() }
  21
  22     Exiting eval via %s
  23         { eval "last" }
  24
  25     Exiting pseudo-block via %s
  26         @a = (1,2) ; @b = sort { last } @a ;
  27
  28     Exiting substitution via %s
  29         $_ = "abc" ;
  30         last fred:
  31         while ($i ++ == 0)
  32         {
  33             s/ab/last fred/e ;
  34         }
  35
  36
  37     Exiting subroutine via %s
  38         sub fred { last joe }
  39         joe: { fred() }
  40
  41     Exiting eval via %s
  42         fred: { eval "last fred" }
  43
  44     Exiting pseudo-block via %s
  45         @a = (1,2) ; fred: @b = sort { last fred } @a ;
  46
  47
  48     Deep recursion on subroutine \"%s\"
  49         sub fred
  50         {
  51           fred() if $a++ < 200
  52         }
  53
  54         fred()
  55
  56       (in cleanup) foo bar
  57         package Foo;
  58         DESTROY { die "foo bar" }
  59         { bless [], 'Foo' for 1..10 }
  60
  61 __END__
  62 # pp_ctl.c
  63 use warnings 'syntax' ;
  64 format STDOUT =
  65 @<<< @<<<
  66 1
  67 .
  68 write;
  69 EXPECT
  70 Not enough format arguments at - line 5.
  71 1
  72 ########
  73 # pp_ctl.c
  74 no warnings 'syntax' ;
  75 format =
  76 @<<< @<<<
  77 1
  78 .
  79 write ;
  80 EXPECT
  81 1
  82 ########
  83 # pp_ctl.c
  84 use warnings 'exiting' ;
  85 $_ = "abc" ;
  86
  87 while ($i ++ == 0)
  88 {
  89     s/ab/last/e ;
  90 }
  91 no warnings 'exiting' ;
  92 while ($i ++ == 0)
  93 {
  94     s/ab/last/e ;
  95 }
  96 EXPECT
  97 Exiting substitution via last at - line 7.
  98 ########
  99 # pp_ctl.c
 100 use warnings 'exiting' ;
 101 sub fred { last }
 102 { fred() }
 103 no warnings 'exiting' ;
 104 sub joe { last }
 105 { joe() }
 106 EXPECT
 107 Exiting subroutine via last at - line 3.
 108 ########
 109 # pp_ctl.c
 110 {
 111   eval "use warnings 'exiting' ; last;"
 112 }
 113 print STDERR $@ ;
 114 {
 115   eval "no warnings 'exiting' ;last;"
 116 }
 117 print STDERR $@ ;
 118 EXPECT
 119 Exiting eval via last at (eval 1) line 1.
 120 ########
 121 # pp_ctl.c
 122 use warnings 'exiting' ;
 123 @a = (1,2) ;
 124 @b = sort { last } @a ;
 125 no warnings 'exiting' ;
 126 @b = sort { last } @a ;
 127 EXPECT
 128 Exiting pseudo-block via last at - line 4.
 129 Can't "last" outside a loop block at - line 4.
 130 ########
 131 # pp_ctl.c
 132 use warnings 'exiting' ;
 133 $_ = "abc" ;
 134 fred:
 135 while ($i ++ == 0)
 136 {
 137     s/ab/last fred/e ;
 138 }
 139 no warnings 'exiting' ;
 140 while ($i ++ == 0)
 141 {
 142     s/ab/last fred/e ;
 143 }
 144 EXPECT
 145 Exiting substitution via last at - line 7.
 146 ########
 147 # pp_ctl.c
 148 use warnings 'exiting' ;
 149 sub fred { last joe }
 150 joe: { fred() }
 151 no warnings 'exiting' ;
 152 sub Fred { last Joe }
 153 Joe: { Fred() }
 154 EXPECT
 155 Exiting subroutine via last at - line 3.
 156 ########
 157 # pp_ctl.c
 158 joe:
 159 { eval "use warnings 'exiting' ; last joe;" }
 160 print STDERR $@ ;
 161 Joe:
 162 { eval "no warnings 'exiting' ; last Joe;" }
 163 print STDERR $@ ;
 164 EXPECT
 165 Exiting eval via last at (eval 1) line 1.
 166 ########
 167 # pp_ctl.c
 168 use warnings 'exiting' ;
 169 @a = (1,2) ;
 170 fred: @b = sort { last fred } @a ;
 171 no warnings 'exiting' ;
 172 Fred: @b = sort { last Fred } @a ;
 173 EXPECT
 174 Exiting pseudo-block via last at - line 4.
 175 Label not found for "last fred" at - line 4.
 176 ########
 177 # pp_ctl.c
 178 use warnings 'recursion' ;
 179 BEGIN { warn "PREFIX\n" ;}
 180 sub fred
 181 {
 182     fred() if $a++ < 200
 183 }
 184
 185 fred()
 186 EXPECT
 187 Deep recursion on subroutine "main::fred" at - line 6.
 188 ########
 189 # pp_ctl.c
 190 no warnings 'recursion' ;
 191 BEGIN { warn "PREFIX\n" ;}
 192 sub fred
 193 {
 194     fred() if $a++ < 200
 195 }
 196
 197 fred()
 198 EXPECT
 199 ########
 200 # pp_ctl.c
 201 use warnings 'misc' ;
 202 package Foo;
 203 DESTROY { die "@{$_[0]} foo bar" }
 204 { bless ['A'], 'Foo' for 1..10 }
 205 { bless ['B'], 'Foo' for 1..10 }
 206 EXPECT
 207         (in cleanup) A foo bar at - line 4.
 208         (in cleanup) A foo bar at - line 4.
 209         (in cleanup) A foo bar at - line 4.
 210         (in cleanup) A foo bar at - line 4.
 211         (in cleanup) A foo bar at - line 4.
 212         (in cleanup) A foo bar at - line 4.
 213         (in cleanup) A foo bar at - line 4.
 214         (in cleanup) A foo bar at - line 4.
 215         (in cleanup) A foo bar at - line 4.
 216         (in cleanup) A foo bar at - line 4.
 217         (in cleanup) B foo bar at - line 4.
 218         (in cleanup) B foo bar at - line 4.
 219         (in cleanup) B foo bar at - line 4.
 220         (in cleanup) B foo bar at - line 4.
 221         (in cleanup) B foo bar at - line 4.
 222         (in cleanup) B foo bar at - line 4.
 223         (in cleanup) B foo bar at - line 4.
 224         (in cleanup) B foo bar at - line 4.
 225         (in cleanup) B foo bar at - line 4.
 226         (in cleanup) B foo bar at - line 4.
 227 ########
 228 # pp_ctl.c
 229 no warnings 'misc' ;
 230 package Foo;
 231 DESTROY { die "@{$_[0]} foo bar" }
 232 { bless ['A'], 'Foo' for 1..10 }
 233 { bless ['B'], 'Foo' for 1..10 }
 234 EXPECT
 235 ########
 236 # pp_ctl.c
 237 use warnings;
 238 eval 'print $foo';
 239 EXPECT
 240 Use of uninitialized value $foo in print at (eval 1) line 1.
 241 ########
 242 # pp_ctl.c
 243 use warnings;
 244 {
 245     no warnings;
 246     eval 'print $foo';
 247 }
 248 EXPECT
 249 ########
 250 # pp_ctl.c
 251 use warnings;
 252 eval 'use 5.006; use 5.10.0';
 253 EXPECT