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