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 | } |
9d8e4b9b | 10 | plan 129; |
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 | 309 | like runperl( |
30d9c59b | 310 | switches => [ '-Mfeature=lexical_subs,state' ], |
fe54d63b FC |
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'; | |
18691622 FC |
316 | { |
317 | state $stuff; | |
318 | package A { | |
319 | state sub foo{ $stuff .= our $AUTOLOAD } | |
320 | *A::AUTOLOAD = \&foo; | |
321 | } | |
322 | A::bar(); | |
323 | is $stuff, 'A::bar', 'state sub assigned to *AUTOLOAD can autoload'; | |
324 | } | |
56117e3e FC |
325 | { |
326 | state sub quire{qr "quires"} | |
327 | package o { use overload qr => \&quire } | |
328 | ok "quires" =~ bless([], o::), 'state sub used as overload method'; | |
329 | } | |
db5cc3ee FC |
330 | { |
331 | state sub foo; | |
332 | *cvgv = \&foo; | |
333 | local *cvgv2 = *cvgv; | |
334 | eval 'sub cvgv2 {42}'; # uses the stub already present | |
335 | is foo, 42, 'defining state sub body via package sub declaration'; | |
336 | } | |
9d8e4b9b FC |
337 | { |
338 | local $ENV{PERL5DB} = 'sub DB::DB{}'; | |
339 | is( | |
340 | runperl( | |
341 | switches => [ '-d' ], | |
342 | progs => [ split "\n", | |
343 | 'use feature qw - lexical_subs state -; | |
344 | no warnings q-experimental::lexical_subs-; | |
345 | sub DB::sub{ print qq|4\n|; goto $DB::sub } | |
346 | state sub foo {print qq|2\n|} | |
347 | foo(); | |
348 | ' | |
349 | ], | |
350 | stderr => 1 | |
351 | ), | |
352 | "4\n2\n", | |
353 | 'state subs and DB::sub under -d' | |
354 | ); | |
355 | } | |
194774c2 FC |
356 | |
357 | # -------------------- my -------------------- # | |
358 | ||
359 | { | |
360 | my sub foo { 44 } | |
361 | isnt \&::foo, \&foo, 'my sub is not stored in the package'; | |
362 | is foo, 44, 'calling my sub from same package'; | |
363 | is &foo, 44, 'calling my sub from same package (amper)'; | |
194774c2 FC |
364 | package bar; |
365 | is foo, 44, 'calling my sub from another package'; | |
366 | is &foo, 44, 'calling my sub from another package (amper)'; | |
194774c2 FC |
367 | } |
368 | package bar; | |
369 | is foo, 43, 'my sub falling out of scope'; | |
370 | is &foo, 43, 'my sub falling out of scope (called via amper)'; | |
194774c2 FC |
371 | { |
372 | sub ma { 43 } | |
373 | my sub ma { | |
374 | if (shift) { | |
375 | is ma, 43, 'my sub invisible inside itself'; | |
376 | is &ma, 43, 'my sub invisible inside itself (called via amper)'; | |
194774c2 FC |
377 | } |
378 | 44 | |
379 | } | |
380 | ma(1); | |
381 | sub mb { 43 } | |
382 | my sub mb; | |
383 | my sub mb { | |
384 | if (shift) { | |
385 | # ‘my sub foo{}’ creates a new pad entry, not reusing the forward | |
386 | # declaration. Being invisible inside itself, it sees the stub. | |
387 | eval{mb}; | |
388 | like $@, qr/^Undefined subroutine &mb called at /, | |
389 | 'my sub foo {} after forward declaration'; | |
390 | eval{&mb}; | |
391 | like $@, qr/^Undefined subroutine &mb called at /, | |
392 | 'my sub foo {} after forward declaration (amper)'; | |
194774c2 FC |
393 | } |
394 | 44 | |
395 | } | |
396 | mb(1); | |
397 | sub mb2 { 43 } | |
398 | my sub sb2; | |
399 | sub mb2 { | |
400 | if (shift) { | |
401 | package bar; | |
402 | is mb2, 44, 'my sub visible inside itself after decl'; | |
403 | is &mb2, 44, 'my sub visible inside itself after decl (amper)'; | |
194774c2 FC |
404 | } |
405 | 44 | |
406 | } | |
407 | mb2(1); | |
408 | my sub mb3; | |
409 | { | |
410 | my sub mb3 { # new pad entry | |
411 | # The sub containing this comment is invisible inside itself. | |
412 | # So this one here will assign to the outer pad entry: | |
413 | sub mb3 { 47 } | |
414 | } | |
415 | } | |
416 | is eval{mb3}, 47, | |
417 | 'sub foo{} applying to "my sub foo;" even inside my sub foo{}'; | |
10342479 FC |
418 | # Same test again, but inside an anonymous sub |
419 | sub { | |
420 | my sub mb4; | |
421 | { | |
422 | my sub mb4 { | |
423 | sub mb4 { 47 } | |
424 | } | |
425 | } | |
426 | is mb4, 47, | |
427 | 'sub foo{} applying to "my sub foo;" even inside my sub foo{}'; | |
428 | }->(); | |
194774c2 FC |
429 | } |
430 | sub mc { 43 } | |
431 | { | |
432 | my sub mc; | |
433 | eval{mc}; | |
434 | like $@, qr/^Undefined subroutine &mc called at /, | |
435 | 'my sub foo; makes no lex alias for existing sub'; | |
436 | eval{&mc}; | |
437 | like $@, qr/^Undefined subroutine &mc called at /, | |
438 | 'my sub foo; makes no lex alias for existing sub (amper)'; | |
194774c2 FC |
439 | } |
440 | package main; | |
441 | { | |
442 | my sub me ($); | |
443 | is prototype eval{\&me}, '$', 'my sub with proto'; | |
444 | is prototype "me", undef, 'prototype "..." ignores my subs'; | |
fdf416b6 BF |
445 | |
446 | my $coderef = eval "my sub foo (\$\x{30cd}) {1}; \\&foo"; | |
447 | my $proto = prototype $coderef; | |
448 | ok(utf8::is_utf8($proto), "my sub with UTF8 proto maintains the UTF8ness"); | |
72e8be86 | 449 | is($proto, "\$\x{30cd}", "check the prototypes actually match"); |
194774c2 FC |
450 | } |
451 | { | |
452 | my sub if() { 44 } | |
453 | my $x = if if if; | |
454 | is $x, 44, 'my subs override all keywords'; | |
455 | package bar; | |
456 | my $y = if if if; | |
457 | is $y, 44, 'my subs from other packages override all keywords'; | |
458 | } | |
459 | { | |
64fbf0dd | 460 | use warnings; no warnings "experimental::lexical_subs"; |
194774c2 FC |
461 | my $w ; |
462 | local $SIG{__WARN__} = sub { $w .= shift }; | |
463 | eval '#line 87 squidges | |
464 | my sub foo; | |
465 | my sub foo {}; | |
466 | '; | |
467 | is $w, | |
468 | '"my" subroutine &foo masks earlier declaration in same scope at ' | |
469 | . "squidges line 88.\n", | |
470 | 'warning for my sub masking earlier declaration'; | |
471 | } | |
472 | # Test that my subs are cloned inside anonymous subs. | |
473 | sub mmake_closure { | |
474 | my $x = shift; | |
475 | sub { | |
476 | my sub foo { $x } | |
477 | foo | |
478 | } | |
479 | } | |
480 | $sub1 = mmake_closure 48; | |
481 | $sub2 = mmake_closure 49; | |
6d5c2147 FC |
482 | is &$sub1, 48, 'my sub in closure (1)'; |
483 | is &$sub2, 49, 'my sub in closure (2)'; | |
194774c2 FC |
484 | # Test that they are cloned in named subs. |
485 | { | |
64fbf0dd | 486 | use warnings; no warnings "experimental::lexical_subs"; |
194774c2 FC |
487 | my $w; |
488 | local $SIG{__WARN__} = sub { $w .= shift }; | |
489 | eval '#line 65 teetet | |
6d5c2147 | 490 | sub mfoom { |
194774c2 FC |
491 | my $x = shift; |
492 | my sub poom { $x } | |
6d5c2147 | 493 | \&poom |
194774c2 FC |
494 | } |
495 | '; | |
496 | is $w, undef, 'my subs get no "Variable will not stay shared" messages'; | |
6d5c2147 FC |
497 | my $poom = mfoom(27); |
498 | my $poom2 = mfoom(678); | |
499 | is $poom->(), 27, 'my subs closing over outer my var (1)'; | |
500 | is $poom2->(), 678, 'my subs closing over outer my var (2)'; | |
194774c2 FC |
501 | my $x = 43; |
502 | my sub aoeu; | |
503 | for $x (765) { | |
504 | my sub etetetet { $x } | |
6d5c2147 | 505 | sub aoeu { $x } |
194774c2 | 506 | is etetetet, 765, 'my sub respects for() localisation'; |
194774c2 FC |
507 | is aoeu, 43, 'unless it is declared outside the for loop'; |
508 | } | |
509 | } | |
510 | # And we also need to test that multiple my subs can close over each | |
511 | # other’s entries in the parent subs pad, and that cv_clone is not con- | |
512 | # fused by that. | |
513 | sub make_anon_with_my_sub{ | |
514 | sub { | |
515 | my sub s1; | |
516 | my sub s2 { \&s1 } | |
517 | sub s1 { \&s2 } | |
518 | if (@_) { return eval { \&s1 } } | |
519 | is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub'; | |
520 | is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub'; | |
521 | } | |
522 | } | |
0afba48f FC |
523 | |
524 | # Test my subs inside predeclared my subs | |
525 | { | |
526 | my sub s2; | |
527 | sub s2 { | |
528 | my $x = 3; | |
529 | my sub s3 { eval '$x' } | |
530 | s3; | |
531 | } | |
0afba48f FC |
532 | is s2, 3, 'my sub inside predeclared my sub'; |
533 | } | |
534 | ||
194774c2 FC |
535 | { |
536 | my $s = make_anon_with_my_sub; | |
537 | &$s; | |
538 | ||
539 | # And make sure the my subs were actually cloned. | |
194774c2 FC |
540 | isnt make_anon_with_my_sub->(0), &$s(0), |
541 | 'my subs in anon subs are cloned'; | |
542 | isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub'; | |
194774c2 FC |
543 | } |
544 | { | |
545 | my sub BEGIN { exit }; | |
546 | pass 'my subs are never special blocks'; | |
547 | my sub END { shift } | |
548 | is END('jkqeudth'), jkqeudth, | |
549 | 'my sub END {shift} implies @_, not @ARGV'; | |
550 | } | |
551 | { | |
552 | my sub redef {} | |
64fbf0dd | 553 | use warnings; no warnings "experimental::lexical_subs"; |
194774c2 FC |
554 | my $w; |
555 | local $SIG{__WARN__} = sub { $w .= shift }; | |
556 | eval "#line 56 pygpyf\nsub redef {}"; | |
557 | is $w, "Subroutine redef redefined at pygpyf line 56.\n", | |
558 | "sub redefinition warnings from my subs"; | |
4e85e1b4 FC |
559 | |
560 | undef $w; | |
561 | sub { | |
562 | my sub x {}; | |
563 | sub { eval "#line 87 khaki\n\\&x" } | |
564 | }->()(); | |
565 | is $w, "Subroutine \"&x\" is not available at khaki line 87.\n", | |
566 | "unavailability warning during compilation of eval in closure"; | |
567 | ||
568 | undef $w; | |
569 | no warnings 'void'; | |
570 | eval <<'->()();'; | |
571 | #line 87 khaki | |
572 | sub { | |
573 | my sub x{} | |
574 | sub not_lexical8 { | |
575 | \&x | |
576 | } | |
577 | } | |
578 | ->()(); | |
579 | is $w, "Subroutine \"&x\" is not available at khaki line 90.\n", | |
580 | "unavailability warning during compilation of named sub in anon"; | |
cf748c3c FC |
581 | |
582 | undef $w; | |
583 | sub not_lexical9 { | |
584 | my sub x {}; | |
585 | format = | |
586 | @ | |
587 | &x | |
588 | . | |
589 | } | |
590 | eval { write }; | |
591 | my($f,$l) = (__FILE__,__LINE__ - 1); | |
592 | is $w, "Subroutine \"&x\" is not available at $f line $l.\n", | |
593 | 'unavailability warning during cloning'; | |
594 | $l -= 3; | |
595 | is $@, "Undefined subroutine &x called at $f line $l.\n", | |
596 | 'Vivified sub is correctly named'; | |
194774c2 | 597 | } |
ebfebee4 FC |
598 | sub not_lexical10 { |
599 | my sub foo; | |
600 | foo(); | |
601 | sub not_lexical11 { | |
602 | my sub bar { | |
603 | my $x = 'khaki car keys for the khaki car'; | |
604 | not_lexical10(); | |
605 | sub foo { | |
606 | is $x, 'khaki car keys for the khaki car', | |
607 | 'mysubs in inner clonables use the running clone of their CvOUTSIDE' | |
608 | } | |
609 | } | |
610 | bar() | |
611 | } | |
612 | } | |
613 | not_lexical11(); | |
279d09bf FC |
614 | { |
615 | my sub p (\@) { | |
616 | is ref $_[0], 'ARRAY', 'my sub with proto'; | |
617 | } | |
618 | p(my @a); | |
9a5e6f3c | 619 | p @a; |
83a72a15 FC |
620 | my sub q () { 46 } |
621 | is q(), 46, 'my constant called with parens'; | |
279d09bf FC |
622 | } |
623 | { | |
624 | my sub x; | |
625 | my $count; | |
626 | sub x { x() if $count++ < 10 } | |
627 | x(); | |
628 | is $count, 11, 'my recursive subs'; | |
629 | } | |
a70c2d56 FC |
630 | { |
631 | my sub x; | |
632 | eval 'sub x {3}'; | |
633 | is x, 3, 'my sub defined inside eval'; | |
634 | } | |
6d5c2147 | 635 | |
4ded55f3 FC |
636 | { |
637 | state $w; | |
638 | local $SIG{__WARN__} = sub { $w .= shift }; | |
639 | eval q{ my sub george () { 2 } }; | |
640 | is $w, undef, 'no double free from constant my subs'; | |
641 | } | |
fe54d63b | 642 | like runperl( |
30d9c59b | 643 | switches => [ '-Mfeature=lexical_subs,state' ], |
fe54d63b FC |
644 | prog => 'my sub a { foo ref } a()', |
645 | stderr => 1 | |
646 | ), | |
647 | qr/syntax error/, | |
648 | 'referencing a my sub after a syntax error does not crash'; | |
18691622 FC |
649 | { |
650 | state $stuff; | |
651 | package A { | |
652 | my sub foo{ $stuff .= our $AUTOLOAD } | |
653 | *A::AUTOLOAD = \&foo; | |
654 | } | |
655 | A::bar(); | |
656 | is $stuff, 'A::bar', 'my sub assigned to *AUTOLOAD can autoload'; | |
657 | } | |
56117e3e FC |
658 | { |
659 | my sub quire{qr "quires"} | |
660 | package mo { use overload qr => \&quire } | |
661 | ok "quires" =~ bless([], mo::), 'my sub used as overload method'; | |
662 | } | |
db5cc3ee FC |
663 | { |
664 | my sub foo; | |
665 | *mcvgv = \&foo; | |
666 | local *mcvgv2 = *mcvgv; | |
667 | eval 'sub mcvgv2 {42}'; # uses the stub already present | |
668 | is foo, 42, 'defining my sub body via package sub declaration'; | |
669 | } | |
670 | { | |
671 | my sub foo; | |
672 | *mcvgv3 = \&foo; | |
673 | local *mcvgv4 = *mcvgv3; | |
674 | eval 'sub mcvgv4 {42}'; # uses the stub already present | |
675 | undef *mcvgv3; undef *mcvgv4; # leaves the pad with the only reference | |
676 | } | |
677 | # We would have crashed by now if it weren’t fixed. | |
678 | pass "pad taking ownership once more of packagified my-sub"; | |
4ded55f3 | 679 | |
9d8e4b9b FC |
680 | { |
681 | local $ENV{PERL5DB} = 'sub DB::DB{}'; | |
682 | is( | |
683 | runperl( | |
684 | switches => [ '-d' ], | |
685 | progs => [ split "\n", | |
686 | 'use feature qw - lexical_subs state -; | |
687 | no warnings q-experimental::lexical_subs-; | |
688 | sub DB::sub{ print qq|4\n|; goto $DB::sub } | |
689 | my sub foo {print qq|2\n|} | |
690 | foo(); | |
691 | ' | |
692 | ], | |
693 | stderr => 1 | |
694 | ), | |
695 | "4\n2\n", | |
696 | 'my subs and DB::sub under -d' | |
697 | ); | |
698 | } | |
699 | ||
6d5c2147 FC |
700 | # -------------------- Interactions (and misc tests) -------------------- # |
701 | ||
702 | is sub { | |
703 | my sub s1; | |
704 | my sub s2 { 3 }; | |
705 | sub s1 { state sub foo { \&s2 } foo } | |
706 | s1 | |
707 | }->()(), 3, 'state sub inside my sub closing over my sub uncle'; | |
708 | ||
0afba48f FC |
709 | { |
710 | my sub s2 { 3 }; | |
711 | sub not_lexical { state sub foo { \&s2 } foo } | |
712 | is not_lexical->(), 3, 'state subs that reference my sub from outside'; | |
713 | } | |
714 | ||
715 | # Test my subs inside predeclared package subs | |
716 | # This test also checks that CvOUTSIDE pointers are not mangled when the | |
717 | # inner sub’s CvOUTSIDE points to another sub. | |
718 | sub not_lexical2; | |
719 | sub not_lexical2 { | |
720 | my $x = 23; | |
721 | my sub bar; | |
722 | sub not_lexical3 { | |
723 | not_lexical2(); | |
724 | sub bar { $x } | |
725 | }; | |
726 | bar | |
727 | } | |
0afba48f FC |
728 | is not_lexical3, 23, 'my subs inside predeclared package subs'; |
729 | ||
730 | # Test my subs inside predeclared package sub, where the lexical sub is | |
731 | # declared outside the package sub. | |
732 | # This checks that CvOUTSIDE pointers are fixed up even when the sub is | |
733 | # not declared inside the sub that its CvOUTSIDE points to. | |
8d88fe29 | 734 | sub not_lexical5 { |
0afba48f FC |
735 | my sub foo; |
736 | sub not_lexical4; | |
737 | sub not_lexical4 { | |
738 | my $x = 234; | |
8d88fe29 | 739 | not_lexical5(); |
0afba48f | 740 | sub foo { $x } |
0afba48f | 741 | } |
8d88fe29 | 742 | foo |
0afba48f | 743 | } |
8d88fe29 FC |
744 | is not_lexical4, 234, |
745 | 'my sub defined in predeclared pkg sub but declared outside'; | |
1f122f9b FC |
746 | |
747 | undef *not_lexical6; | |
748 | { | |
749 | my sub foo; | |
750 | sub not_lexical6 { sub foo { } } | |
751 | pass 'no crash when cloning a mysub declared inside an undef pack sub'; | |
752 | } | |
9ccc915e FC |
753 | |
754 | undef ¬_lexical7; | |
755 | eval 'sub not_lexical7 { my @x }'; | |
756 | { | |
757 | my sub foo; | |
758 | foo(); | |
759 | sub not_lexical7 { | |
760 | state $x; | |
761 | sub foo { | |
762 | is ref \$x, 'SCALAR', | |
763 | "redeffing a mysub's outside does not make it use the wrong pad" | |
764 | } | |
765 | } | |
766 | } | |
07b2687d LM |
767 | |
768 | like runperl( | |
30d9c59b | 769 | switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ], |
07b2687d LM |
770 | prog => 'my sub foo; sub foo { foo } foo', |
771 | stderr => 1 | |
772 | ), | |
773 | qr/Deep recursion on subroutine "foo"/, | |
774 | 'deep recursion warnings for lexical subs do not crash'; | |
bdbfc51a FC |
775 | |
776 | like runperl( | |
30d9c59b | 777 | switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ], |
bdbfc51a FC |
778 | prog => 'my sub foo() { 42 } undef &foo', |
779 | stderr => 1 | |
780 | ), | |
781 | qr/Constant subroutine foo undefined at /, | |
782 | 'constant undefinition warnings for lexical subs do not crash'; | |
8bfda0d7 FC |
783 | |
784 | { | |
785 | my sub foo; | |
786 | *AutoloadTestSuper::blah = \&foo; | |
787 | sub AutoloadTestSuper::AUTOLOAD { | |
788 | is $AutoloadTestSuper::AUTOLOAD, "AutoloadTestSuper::blah", | |
789 | "Autoloading via inherited lex stub"; | |
790 | } | |
791 | @AutoloadTest::ISA = AutoloadTestSuper::; | |
792 | AutoloadTest->blah; | |
793 | } |