Commit | Line | Data |
---|---|---|
c07656ed FC |
1 | #!perl |
2 | ||
39075fb1 FC |
3 | BEGIN { |
4 | chdir 't'; | |
4b473a5a | 5 | @INC = '../lib'; |
39075fb1 FC |
6 | require './test.pl'; |
7 | *bar::is = *is; | |
21452252 | 8 | *bar::like = *like; |
39075fb1 | 9 | } |
8c74b414 | 10 | plan 120; |
e7d0b801 FC |
11 | |
12 | # -------------------- Errors with feature disabled -------------------- # | |
13 | ||
14 | eval "#line 8 foo\nmy sub foo"; | |
15 | is $@, qq 'Experimental "my" subs not enabled at foo line 8.\n', | |
16 | 'my sub unexperimental error'; | |
17 | eval "#line 8 foo\nCORE::state sub foo"; | |
18 | is $@, qq 'Experimental "state" subs not enabled at foo line 8.\n', | |
19 | 'state sub unexperimental error'; | |
20 | eval "#line 8 foo\nour sub foo"; | |
21 | is $@, qq 'Experimental "our" subs not enabled at foo line 8.\n', | |
22 | 'our sub unexperimental error'; | |
21452252 FC |
23 | |
24 | # -------------------- our -------------------- # | |
c07656ed | 25 | |
f1d34ca8 | 26 | no warnings "experimental::lexical_subs"; |
e7d0b801 | 27 | use feature 'lexical_subs'; |
c07656ed FC |
28 | { |
29 | our sub foo { 42 } | |
39075fb1 FC |
30 | is foo, 42, 'calling our sub from same package'; |
31 | is &foo, 42, 'calling our sub from same package (amper)'; | |
c07656ed FC |
32 | package bar; |
33 | sub bar::foo { 43 } | |
18f70389 | 34 | is foo, 42, 'calling our sub from another package'; |
39075fb1 | 35 | is &foo, 42, 'calling our sub from another package (amper)'; |
c07656ed FC |
36 | } |
37 | package bar; | |
39075fb1 FC |
38 | is foo, 43, 'our sub falling out of scope'; |
39 | is &foo, 43, 'our sub falling out of scope (called via amper)'; | |
c07656ed FC |
40 | package main; |
41 | { | |
42 | sub bar::a { 43 } | |
43 | our sub a { | |
44 | if (shift) { | |
45 | package bar; | |
39075fb1 FC |
46 | is a, 43, 'our sub invisible inside itself'; |
47 | is &a, 43, 'our sub invisible inside itself (called via amper)'; | |
c07656ed FC |
48 | } |
49 | 42 | |
50 | } | |
51 | a(1); | |
52 | sub bar::b { 43 } | |
53 | our sub b; | |
54 | our sub b { | |
55 | if (shift) { | |
56 | package bar; | |
18f70389 | 57 | is b, 42, 'our sub visible inside itself after decl'; |
39075fb1 | 58 | is &b, 42, 'our sub visible inside itself after decl (amper)'; |
c07656ed FC |
59 | } |
60 | 42 | |
61 | } | |
62 | b(1) | |
63 | } | |
64 | sub c { 42 } | |
65 | sub bar::c { 43 } | |
66 | { | |
67 | our sub c; | |
68 | package bar; | |
18f70389 | 69 | is c, 42, 'our sub foo; makes lex alias for existing sub'; |
39075fb1 | 70 | is &c, 42, 'our sub foo; makes lex alias for existing sub (amper)'; |
c07656ed FC |
71 | } |
72 | { | |
73 | our sub d; | |
c07656ed FC |
74 | sub bar::d { 'd43' } |
75 | package bar; | |
945534e1 | 76 | sub d { 'd42' } |
4210d3f1 | 77 | is eval ::d, 'd42', 'our sub foo; applies to subsequent sub foo {}'; |
c07656ed | 78 | } |
60ac52eb FC |
79 | { |
80 | our sub e ($); | |
81 | is prototype "::e", '$', 'our sub with proto'; | |
82 | } | |
18f70389 | 83 | { |
18f70389 FC |
84 | our sub if() { 42 } |
85 | my $x = if if if; | |
f37b842a FC |
86 | is $x, 42, 'lexical subs (even our) override all keywords'; |
87 | package bar; | |
88 | my $y = if if if; | |
89 | is $y, 42, 'our subs from other packages override all keywords'; | |
18f70389 | 90 | } |
21452252 FC |
91 | |
92 | # -------------------- state -------------------- # | |
93 | ||
e7d0b801 | 94 | use feature 'state'; # state |
21452252 FC |
95 | { |
96 | state sub foo { 44 } | |
97b03d64 FC |
97 | isnt \&::foo, \&foo, 'state sub is not stored in the package'; |
98 | is eval foo, 44, 'calling state sub from same package'; | |
99 | is eval &foo, 44, 'calling state sub from same package (amper)'; | |
21452252 | 100 | package bar; |
97b03d64 FC |
101 | is eval foo, 44, 'calling state sub from another package'; |
102 | is eval &foo, 44, 'calling state sub from another package (amper)'; | |
21452252 | 103 | } |
21452252 FC |
104 | package bar; |
105 | is foo, 43, 'state sub falling out of scope'; | |
106 | is &foo, 43, 'state sub falling out of scope (called via amper)'; | |
21452252 FC |
107 | { |
108 | sub sa { 43 } | |
109 | state sub sa { | |
110 | if (shift) { | |
111 | is sa, 43, 'state sub invisible inside itself'; | |
112 | is &sa, 43, 'state sub invisible inside itself (called via amper)'; | |
21452252 FC |
113 | } |
114 | 44 | |
115 | } | |
21452252 | 116 | sa(1); |
21452252 FC |
117 | sub sb { 43 } |
118 | state sub sb; | |
119 | state sub sb { | |
120 | if (shift) { | |
121 | # ‘state sub foo{}’ creates a new pad entry, not reusing the forward | |
122 | # declaration. Being invisible inside itself, it sees the stub. | |
123 | eval{sb}; | |
124 | like $@, qr/^Undefined subroutine &sb called at /, | |
125 | 'state sub foo {} after forward declaration'; | |
126 | eval{&sb}; | |
127 | like $@, qr/^Undefined subroutine &sb called at /, | |
128 | 'state sub foo {} after forward declaration (amper)'; | |
21452252 FC |
129 | } |
130 | 44 | |
131 | } | |
21452252 | 132 | sb(1); |
21452252 FC |
133 | sub sb2 { 43 } |
134 | state sub sb2; | |
135 | sub sb2 { | |
136 | if (shift) { | |
137 | package bar; | |
97b03d64 FC |
138 | is sb2, 44, 'state sub visible inside itself after decl'; |
139 | is &sb2, 44, 'state sub visible inside itself after decl (amper)'; | |
21452252 FC |
140 | } |
141 | 44 | |
142 | } | |
21452252 | 143 | sb2(1); |
21452252 FC |
144 | state sub sb3; |
145 | { | |
146 | state sub sb3 { # new pad entry | |
147 | # The sub containing this comment is invisible inside itself. | |
148 | # So this one here will assign to the outer pad entry: | |
149 | sub sb3 { 47 } | |
150 | } | |
151 | } | |
21452252 FC |
152 | is eval{sb3}, 47, |
153 | 'sub foo{} applying to "state sub foo;" even inside state sub foo{}'; | |
10342479 FC |
154 | # Same test again, but inside an anonymous sub |
155 | sub { | |
156 | state sub sb4; | |
157 | { | |
158 | state sub sb4 { | |
159 | sub sb4 { 47 } | |
160 | } | |
161 | } | |
162 | is sb4, 47, | |
163 | 'sub foo{} applying to "state sub foo;" even inside state sub foo{}'; | |
164 | }->(); | |
21452252 FC |
165 | } |
166 | sub sc { 43 } | |
167 | { | |
168 | state sub sc; | |
169 | eval{sc}; | |
251a11d5 | 170 | like $@, qr/^Undefined subroutine &sc called at /, |
21452252 FC |
171 | 'state sub foo; makes no lex alias for existing sub'; |
172 | eval{&sc}; | |
251a11d5 | 173 | like $@, qr/^Undefined subroutine &sc called at /, |
21452252 | 174 | 'state sub foo; makes no lex alias for existing sub (amper)'; |
21452252 FC |
175 | } |
176 | package main; | |
177 | { | |
178 | state sub se ($); | |
179 | is prototype eval{\&se}, '$', 'state sub with proto'; | |
21452252 FC |
180 | is prototype "se", undef, 'prototype "..." ignores state subs'; |
181 | } | |
182 | { | |
183 | state sub if() { 44 } | |
184 | my $x = if if if; | |
185 | is $x, 44, 'state subs override all keywords'; | |
186 | package bar; | |
187 | my $y = if if if; | |
188 | is $y, 44, 'state subs from other packages override all keywords'; | |
189 | } | |
190 | { | |
64fbf0dd | 191 | use warnings; no warnings "experimental::lexical_subs"; |
21452252 FC |
192 | state $w ; |
193 | local $SIG{__WARN__} = sub { $w .= shift }; | |
194 | eval '#line 87 squidges | |
195 | state sub foo; | |
196 | state sub foo {}; | |
197 | '; | |
21452252 | 198 | is $w, |
4eb94d7c | 199 | '"state" subroutine &foo masks earlier declaration in same scope at ' |
21452252 | 200 | . "squidges line 88.\n", |
4eb94d7c | 201 | 'warning for state sub masking earlier declaration'; |
21452252 FC |
202 | } |
203 | # Since state vars inside anonymous subs are cloned at the same time as the | |
204 | # anonymous subs containing them, the same should happen for state subs. | |
205 | sub make_closure { | |
e07561e6 | 206 | my $x = shift; |
21452252 FC |
207 | sub { |
208 | state sub foo { $x } | |
e07561e6 | 209 | foo |
21452252 FC |
210 | } |
211 | } | |
212 | $sub1 = make_closure 48; | |
213 | $sub2 = make_closure 49; | |
214 | is &$sub1, 48, 'state sub in closure (1)'; | |
97b03d64 | 215 | is &$sub2, 49, 'state sub in closure (2)'; |
21452252 FC |
216 | # But we need to test that state subs actually do persist from one invoca- |
217 | # tion of a named sub to another (i.e., that they are not my subs). | |
218 | { | |
64fbf0dd | 219 | use warnings; no warnings "experimental::lexical_subs"; |
21452252 FC |
220 | state $w; |
221 | local $SIG{__WARN__} = sub { $w .= shift }; | |
222 | eval '#line 65 teetet | |
223 | sub foom { | |
224 | my $x = shift; | |
225 | state sub poom { $x } | |
226 | eval{\&poom} | |
227 | } | |
228 | '; | |
229 | is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n", | |
230 | 'state subs get "Variable will not stay shared" messages'; | |
231 | my $poom = foom(27); | |
232 | my $poom2 = foom(678); | |
233 | is eval{$poom->()}, eval {$poom2->()}, | |
234 | 'state subs close over the first outer my var, like pkg subs'; | |
235 | my $x = 43; | |
236 | for $x (765) { | |
237 | state sub etetetet { $x } | |
c8e83515 | 238 | is eval{etetetet}, 43, 'state sub ignores for() localisation'; |
21452252 FC |
239 | } |
240 | } | |
e07561e6 FC |
241 | # And we also need to test that multiple state subs can close over each |
242 | # other’s entries in the parent subs pad, and that cv_clone is not con- | |
243 | # fused by that. | |
244 | sub make_anon_with_state_sub{ | |
245 | sub { | |
246 | state sub s1; | |
247 | state sub s2 { \&s1 } | |
248 | sub s1 { \&s2 } | |
249 | if (@_) { return \&s1 } | |
250 | is s1,\&s2, 'state sub in anon closure closing over sibling state sub'; | |
251 | is s2,\&s1, 'state sub in anon closure closing over sibling state sub'; | |
252 | } | |
253 | } | |
254 | { | |
255 | my $s = make_anon_with_state_sub; | |
256 | &$s; | |
257 | ||
258 | # And make sure the state subs were actually cloned. | |
259 | isnt make_anon_with_state_sub->(0), &$s(0), | |
260 | 'state subs in anon subs are cloned'; | |
261 | is &$s(0), &$s(0), 'but only when the anon sub is cloned'; | |
262 | } | |
21452252 FC |
263 | { |
264 | state sub BEGIN { exit }; | |
265 | pass 'state subs are never special blocks'; | |
266 | state sub END { shift } | |
21452252 FC |
267 | is eval{END('jkqeudth')}, jkqeudth, |
268 | 'state sub END {shift} implies @_, not @ARGV'; | |
a96df643 FC |
269 | state sub CORE { scalar reverse shift } |
270 | is CORE::uc("hello"), "HELLO", | |
271 | 'lexical CORE does not interfere with CORE::...'; | |
21452252 FC |
272 | } |
273 | { | |
274 | state sub redef {} | |
64fbf0dd | 275 | use warnings; no warnings "experimental::lexical_subs"; |
21452252 FC |
276 | state $w; |
277 | local $SIG{__WARN__} = sub { $w .= shift }; | |
278 | eval "#line 56 pygpyf\nsub redef {}"; | |
279 | is $w, "Subroutine redef redefined at pygpyf line 56.\n", | |
280 | "sub redefinition warnings from state subs"; | |
281 | } | |
279d09bf FC |
282 | { |
283 | state sub p (\@) { | |
284 | is ref $_[0], 'ARRAY', 'state sub with proto'; | |
285 | } | |
286 | p(my @a); | |
9a5e6f3c | 287 | p my @b; |
83a72a15 FC |
288 | state sub q () { 45 } |
289 | is q(), 45, 'state constant called with parens'; | |
279d09bf | 290 | } |
c388b213 FC |
291 | { |
292 | state sub x; | |
293 | eval 'sub x {3}'; | |
294 | is x, 3, 'state sub defined inside eval'; | |
a70c2d56 FC |
295 | |
296 | sub r { | |
297 | state sub foo { 3 }; | |
298 | if (@_) { # outer call | |
299 | r(); | |
300 | is foo(), 42, | |
301 | 'state sub run-time redefinition applies to all recursion levels'; | |
302 | } | |
303 | else { # inner call | |
304 | eval 'sub foo { 42 }'; | |
305 | } | |
306 | } | |
307 | r(1); | |
c388b213 | 308 | } |
fe54d63b FC |
309 | like runperl( |
310 | switches => [ '-Mfeature=:all' ], | |
311 | prog => 'state sub a { foo ref } a()', | |
312 | stderr => 1 | |
313 | ), | |
314 | qr/syntax error/, | |
315 | 'referencing a state sub after a syntax error does not crash'; | |
194774c2 FC |
316 | |
317 | # -------------------- my -------------------- # | |
318 | ||
319 | { | |
320 | my sub foo { 44 } | |
321 | isnt \&::foo, \&foo, 'my sub is not stored in the package'; | |
322 | is foo, 44, 'calling my sub from same package'; | |
323 | is &foo, 44, 'calling my sub from same package (amper)'; | |
194774c2 FC |
324 | package bar; |
325 | is foo, 44, 'calling my sub from another package'; | |
326 | is &foo, 44, 'calling my sub from another package (amper)'; | |
194774c2 FC |
327 | } |
328 | package bar; | |
329 | is foo, 43, 'my sub falling out of scope'; | |
330 | is &foo, 43, 'my sub falling out of scope (called via amper)'; | |
194774c2 FC |
331 | { |
332 | sub ma { 43 } | |
333 | my sub ma { | |
334 | if (shift) { | |
335 | is ma, 43, 'my sub invisible inside itself'; | |
336 | is &ma, 43, 'my sub invisible inside itself (called via amper)'; | |
194774c2 FC |
337 | } |
338 | 44 | |
339 | } | |
340 | ma(1); | |
341 | sub mb { 43 } | |
342 | my sub mb; | |
343 | my sub mb { | |
344 | if (shift) { | |
345 | # ‘my sub foo{}’ creates a new pad entry, not reusing the forward | |
346 | # declaration. Being invisible inside itself, it sees the stub. | |
347 | eval{mb}; | |
348 | like $@, qr/^Undefined subroutine &mb called at /, | |
349 | 'my sub foo {} after forward declaration'; | |
350 | eval{&mb}; | |
351 | like $@, qr/^Undefined subroutine &mb called at /, | |
352 | 'my sub foo {} after forward declaration (amper)'; | |
194774c2 FC |
353 | } |
354 | 44 | |
355 | } | |
356 | mb(1); | |
357 | sub mb2 { 43 } | |
358 | my sub sb2; | |
359 | sub mb2 { | |
360 | if (shift) { | |
361 | package bar; | |
362 | is mb2, 44, 'my sub visible inside itself after decl'; | |
363 | is &mb2, 44, 'my sub visible inside itself after decl (amper)'; | |
194774c2 FC |
364 | } |
365 | 44 | |
366 | } | |
367 | mb2(1); | |
368 | my sub mb3; | |
369 | { | |
370 | my sub mb3 { # new pad entry | |
371 | # The sub containing this comment is invisible inside itself. | |
372 | # So this one here will assign to the outer pad entry: | |
373 | sub mb3 { 47 } | |
374 | } | |
375 | } | |
376 | is eval{mb3}, 47, | |
377 | 'sub foo{} applying to "my sub foo;" even inside my sub foo{}'; | |
10342479 FC |
378 | # Same test again, but inside an anonymous sub |
379 | sub { | |
380 | my sub mb4; | |
381 | { | |
382 | my sub mb4 { | |
383 | sub mb4 { 47 } | |
384 | } | |
385 | } | |
386 | is mb4, 47, | |
387 | 'sub foo{} applying to "my sub foo;" even inside my sub foo{}'; | |
388 | }->(); | |
194774c2 FC |
389 | } |
390 | sub mc { 43 } | |
391 | { | |
392 | my sub mc; | |
393 | eval{mc}; | |
394 | like $@, qr/^Undefined subroutine &mc called at /, | |
395 | 'my sub foo; makes no lex alias for existing sub'; | |
396 | eval{&mc}; | |
397 | like $@, qr/^Undefined subroutine &mc called at /, | |
398 | 'my sub foo; makes no lex alias for existing sub (amper)'; | |
194774c2 FC |
399 | } |
400 | package main; | |
401 | { | |
402 | my sub me ($); | |
403 | is prototype eval{\&me}, '$', 'my sub with proto'; | |
404 | is prototype "me", undef, 'prototype "..." ignores my subs'; | |
fdf416b6 BF |
405 | |
406 | my $coderef = eval "my sub foo (\$\x{30cd}) {1}; \\&foo"; | |
407 | my $proto = prototype $coderef; | |
408 | ok(utf8::is_utf8($proto), "my sub with UTF8 proto maintains the UTF8ness"); | |
72e8be86 | 409 | is($proto, "\$\x{30cd}", "check the prototypes actually match"); |
194774c2 FC |
410 | } |
411 | { | |
412 | my sub if() { 44 } | |
413 | my $x = if if if; | |
414 | is $x, 44, 'my subs override all keywords'; | |
415 | package bar; | |
416 | my $y = if if if; | |
417 | is $y, 44, 'my subs from other packages override all keywords'; | |
418 | } | |
419 | { | |
64fbf0dd | 420 | use warnings; no warnings "experimental::lexical_subs"; |
194774c2 FC |
421 | my $w ; |
422 | local $SIG{__WARN__} = sub { $w .= shift }; | |
423 | eval '#line 87 squidges | |
424 | my sub foo; | |
425 | my sub foo {}; | |
426 | '; | |
427 | is $w, | |
428 | '"my" subroutine &foo masks earlier declaration in same scope at ' | |
429 | . "squidges line 88.\n", | |
430 | 'warning for my sub masking earlier declaration'; | |
431 | } | |
432 | # Test that my subs are cloned inside anonymous subs. | |
433 | sub mmake_closure { | |
434 | my $x = shift; | |
435 | sub { | |
436 | my sub foo { $x } | |
437 | foo | |
438 | } | |
439 | } | |
440 | $sub1 = mmake_closure 48; | |
441 | $sub2 = mmake_closure 49; | |
6d5c2147 FC |
442 | is &$sub1, 48, 'my sub in closure (1)'; |
443 | is &$sub2, 49, 'my sub in closure (2)'; | |
194774c2 FC |
444 | # Test that they are cloned in named subs. |
445 | { | |
64fbf0dd | 446 | use warnings; no warnings "experimental::lexical_subs"; |
194774c2 FC |
447 | my $w; |
448 | local $SIG{__WARN__} = sub { $w .= shift }; | |
449 | eval '#line 65 teetet | |
6d5c2147 | 450 | sub mfoom { |
194774c2 FC |
451 | my $x = shift; |
452 | my sub poom { $x } | |
6d5c2147 | 453 | \&poom |
194774c2 FC |
454 | } |
455 | '; | |
456 | is $w, undef, 'my subs get no "Variable will not stay shared" messages'; | |
6d5c2147 FC |
457 | my $poom = mfoom(27); |
458 | my $poom2 = mfoom(678); | |
459 | is $poom->(), 27, 'my subs closing over outer my var (1)'; | |
460 | is $poom2->(), 678, 'my subs closing over outer my var (2)'; | |
194774c2 FC |
461 | my $x = 43; |
462 | my sub aoeu; | |
463 | for $x (765) { | |
464 | my sub etetetet { $x } | |
6d5c2147 | 465 | sub aoeu { $x } |
194774c2 | 466 | is etetetet, 765, 'my sub respects for() localisation'; |
194774c2 FC |
467 | is aoeu, 43, 'unless it is declared outside the for loop'; |
468 | } | |
469 | } | |
470 | # And we also need to test that multiple my subs can close over each | |
471 | # other’s entries in the parent subs pad, and that cv_clone is not con- | |
472 | # fused by that. | |
473 | sub make_anon_with_my_sub{ | |
474 | sub { | |
475 | my sub s1; | |
476 | my sub s2 { \&s1 } | |
477 | sub s1 { \&s2 } | |
478 | if (@_) { return eval { \&s1 } } | |
479 | is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub'; | |
480 | is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub'; | |
481 | } | |
482 | } | |
0afba48f FC |
483 | |
484 | # Test my subs inside predeclared my subs | |
485 | { | |
486 | my sub s2; | |
487 | sub s2 { | |
488 | my $x = 3; | |
489 | my sub s3 { eval '$x' } | |
490 | s3; | |
491 | } | |
0afba48f FC |
492 | is s2, 3, 'my sub inside predeclared my sub'; |
493 | } | |
494 | ||
194774c2 FC |
495 | { |
496 | my $s = make_anon_with_my_sub; | |
497 | &$s; | |
498 | ||
499 | # And make sure the my subs were actually cloned. | |
194774c2 FC |
500 | isnt make_anon_with_my_sub->(0), &$s(0), |
501 | 'my subs in anon subs are cloned'; | |
502 | isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub'; | |
194774c2 FC |
503 | } |
504 | { | |
505 | my sub BEGIN { exit }; | |
506 | pass 'my subs are never special blocks'; | |
507 | my sub END { shift } | |
508 | is END('jkqeudth'), jkqeudth, | |
509 | 'my sub END {shift} implies @_, not @ARGV'; | |
510 | } | |
511 | { | |
512 | my sub redef {} | |
64fbf0dd | 513 | use warnings; no warnings "experimental::lexical_subs"; |
194774c2 FC |
514 | my $w; |
515 | local $SIG{__WARN__} = sub { $w .= shift }; | |
516 | eval "#line 56 pygpyf\nsub redef {}"; | |
517 | is $w, "Subroutine redef redefined at pygpyf line 56.\n", | |
518 | "sub redefinition warnings from my subs"; | |
4e85e1b4 FC |
519 | |
520 | undef $w; | |
521 | sub { | |
522 | my sub x {}; | |
523 | sub { eval "#line 87 khaki\n\\&x" } | |
524 | }->()(); | |
525 | is $w, "Subroutine \"&x\" is not available at khaki line 87.\n", | |
526 | "unavailability warning during compilation of eval in closure"; | |
527 | ||
528 | undef $w; | |
529 | no warnings 'void'; | |
530 | eval <<'->()();'; | |
531 | #line 87 khaki | |
532 | sub { | |
533 | my sub x{} | |
534 | sub not_lexical8 { | |
535 | \&x | |
536 | } | |
537 | } | |
538 | ->()(); | |
539 | is $w, "Subroutine \"&x\" is not available at khaki line 90.\n", | |
540 | "unavailability warning during compilation of named sub in anon"; | |
cf748c3c FC |
541 | |
542 | undef $w; | |
543 | sub not_lexical9 { | |
544 | my sub x {}; | |
545 | format = | |
546 | @ | |
547 | &x | |
548 | . | |
549 | } | |
550 | eval { write }; | |
551 | my($f,$l) = (__FILE__,__LINE__ - 1); | |
552 | is $w, "Subroutine \"&x\" is not available at $f line $l.\n", | |
553 | 'unavailability warning during cloning'; | |
554 | $l -= 3; | |
555 | is $@, "Undefined subroutine &x called at $f line $l.\n", | |
556 | 'Vivified sub is correctly named'; | |
194774c2 | 557 | } |
ebfebee4 FC |
558 | sub not_lexical10 { |
559 | my sub foo; | |
560 | foo(); | |
561 | sub not_lexical11 { | |
562 | my sub bar { | |
563 | my $x = 'khaki car keys for the khaki car'; | |
564 | not_lexical10(); | |
565 | sub foo { | |
566 | is $x, 'khaki car keys for the khaki car', | |
567 | 'mysubs in inner clonables use the running clone of their CvOUTSIDE' | |
568 | } | |
569 | } | |
570 | bar() | |
571 | } | |
572 | } | |
573 | not_lexical11(); | |
279d09bf FC |
574 | { |
575 | my sub p (\@) { | |
576 | is ref $_[0], 'ARRAY', 'my sub with proto'; | |
577 | } | |
578 | p(my @a); | |
9a5e6f3c | 579 | p @a; |
83a72a15 FC |
580 | my sub q () { 46 } |
581 | is q(), 46, 'my constant called with parens'; | |
279d09bf FC |
582 | } |
583 | { | |
584 | my sub x; | |
585 | my $count; | |
586 | sub x { x() if $count++ < 10 } | |
587 | x(); | |
588 | is $count, 11, 'my recursive subs'; | |
589 | } | |
a70c2d56 FC |
590 | { |
591 | my sub x; | |
592 | eval 'sub x {3}'; | |
593 | is x, 3, 'my sub defined inside eval'; | |
594 | } | |
6d5c2147 | 595 | |
4ded55f3 FC |
596 | { |
597 | state $w; | |
598 | local $SIG{__WARN__} = sub { $w .= shift }; | |
599 | eval q{ my sub george () { 2 } }; | |
600 | is $w, undef, 'no double free from constant my subs'; | |
601 | } | |
fe54d63b FC |
602 | like runperl( |
603 | switches => [ '-Mfeature=:all' ], | |
604 | prog => 'my sub a { foo ref } a()', | |
605 | stderr => 1 | |
606 | ), | |
607 | qr/syntax error/, | |
608 | 'referencing a my sub after a syntax error does not crash'; | |
4ded55f3 | 609 | |
6d5c2147 FC |
610 | # -------------------- Interactions (and misc tests) -------------------- # |
611 | ||
612 | is sub { | |
613 | my sub s1; | |
614 | my sub s2 { 3 }; | |
615 | sub s1 { state sub foo { \&s2 } foo } | |
616 | s1 | |
617 | }->()(), 3, 'state sub inside my sub closing over my sub uncle'; | |
618 | ||
0afba48f FC |
619 | { |
620 | my sub s2 { 3 }; | |
621 | sub not_lexical { state sub foo { \&s2 } foo } | |
622 | is not_lexical->(), 3, 'state subs that reference my sub from outside'; | |
623 | } | |
624 | ||
625 | # Test my subs inside predeclared package subs | |
626 | # This test also checks that CvOUTSIDE pointers are not mangled when the | |
627 | # inner sub’s CvOUTSIDE points to another sub. | |
628 | sub not_lexical2; | |
629 | sub not_lexical2 { | |
630 | my $x = 23; | |
631 | my sub bar; | |
632 | sub not_lexical3 { | |
633 | not_lexical2(); | |
634 | sub bar { $x } | |
635 | }; | |
636 | bar | |
637 | } | |
0afba48f FC |
638 | is not_lexical3, 23, 'my subs inside predeclared package subs'; |
639 | ||
640 | # Test my subs inside predeclared package sub, where the lexical sub is | |
641 | # declared outside the package sub. | |
642 | # This checks that CvOUTSIDE pointers are fixed up even when the sub is | |
643 | # not declared inside the sub that its CvOUTSIDE points to. | |
8d88fe29 | 644 | sub not_lexical5 { |
0afba48f FC |
645 | my sub foo; |
646 | sub not_lexical4; | |
647 | sub not_lexical4 { | |
648 | my $x = 234; | |
8d88fe29 | 649 | not_lexical5(); |
0afba48f | 650 | sub foo { $x } |
0afba48f | 651 | } |
8d88fe29 | 652 | foo |
0afba48f | 653 | } |
8d88fe29 FC |
654 | is not_lexical4, 234, |
655 | 'my sub defined in predeclared pkg sub but declared outside'; | |
1f122f9b FC |
656 | |
657 | undef *not_lexical6; | |
658 | { | |
659 | my sub foo; | |
660 | sub not_lexical6 { sub foo { } } | |
661 | pass 'no crash when cloning a mysub declared inside an undef pack sub'; | |
662 | } | |
9ccc915e FC |
663 | |
664 | undef ¬_lexical7; | |
665 | eval 'sub not_lexical7 { my @x }'; | |
666 | { | |
667 | my sub foo; | |
668 | foo(); | |
669 | sub not_lexical7 { | |
670 | state $x; | |
671 | sub foo { | |
672 | is ref \$x, 'SCALAR', | |
673 | "redeffing a mysub's outside does not make it use the wrong pad" | |
674 | } | |
675 | } | |
676 | } | |
07b2687d LM |
677 | |
678 | like runperl( | |
679 | switches => [ '-Mfeature=:all', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ], | |
680 | prog => 'my sub foo; sub foo { foo } foo', | |
681 | stderr => 1 | |
682 | ), | |
683 | qr/Deep recursion on subroutine "foo"/, | |
684 | 'deep recursion warnings for lexical subs do not crash'; | |
bdbfc51a FC |
685 | |
686 | like runperl( | |
687 | switches => [ '-Mfeature=:all', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ], | |
688 | prog => 'my sub foo() { 42 } undef &foo', | |
689 | stderr => 1 | |
690 | ), | |
691 | qr/Constant subroutine foo undefined at /, | |
692 | 'constant undefinition warnings for lexical subs do not crash'; | |
8bfda0d7 FC |
693 | |
694 | { | |
695 | my sub foo; | |
696 | *AutoloadTestSuper::blah = \&foo; | |
697 | sub AutoloadTestSuper::AUTOLOAD { | |
698 | is $AutoloadTestSuper::AUTOLOAD, "AutoloadTestSuper::blah", | |
699 | "Autoloading via inherited lex stub"; | |
700 | } | |
701 | @AutoloadTest::ISA = AutoloadTestSuper::; | |
702 | AutoloadTest->blah; | |
703 | } |