This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
27efbcbda5f9eff88c2b973f4f9443cb728d8709
[perl5.git] / 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
254 ########
255 # SKIP ? !$Config{default_inc_includes_dot}
256 # NAME check warning for do with no . in @INC
257 open my $fh, ">", "dounknown";
258 close $fh;
259 do "dounknown";
260 do "./dounknown";
261 no warnings 'deprecated';
262 do "dounknown";
263 do "./dounknown";
264 unlink "dounknown";
265 EXPECT
266 do "dounknown" failed, '.' is no longer in @INC at - line 3.