This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make ‘No comma allowed’ respect lex subs
[perl5.git] / t / op / lexsub.t
CommitLineData
c07656ed
FC
1#!perl
2
39075fb1
FC
3BEGIN {
4 chdir 't';
5 require './test.pl';
43ece5b1 6 set_up_inc('../lib');
39075fb1 7 *bar::is = *is;
21452252 8 *bar::like = *like;
39075fb1 9}
dffc5024 10plan 141;
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}
8536f7a0
FC
91# Interaction with ‘use constant’
92{
93 our sub const; # symtab now has an undefined CV
94 BEGIN { delete $::{const} } # delete symtab entry; pad entry still exists
95 use constant const => 3; # symtab now has a scalar ref
96 # inlining this used to fail an assertion (parentheses necessary):
97 is(const, 3, 'our sub pointing to "use constant" constant');
98}
a14c24d0
FC
99# our sub and method confusion
100sub F::h { 4242 }
101{
102 my $called;
103 our sub h { ++$called; 4343 };
104 is((h F),4242, 'our sub symbol translation does not affect meth names');
105 undef $called;
106 print "#";
107 print h F; # follows a different path through yylex to intuit_method
108 print "\n";
109 is $called, undef, 'our sub symbol translation & meth names after print'
110}
e3a09cfb
FC
111our sub j;
112is j
113 =>, 'j', 'name_of_our_sub <newline> => is parsed properly';
21452252
FC
114
115# -------------------- state -------------------- #
116
e7d0b801 117use feature 'state'; # state
21452252
FC
118{
119 state sub foo { 44 }
97b03d64
FC
120 isnt \&::foo, \&foo, 'state sub is not stored in the package';
121 is eval foo, 44, 'calling state sub from same package';
122 is eval &foo, 44, 'calling state sub from same package (amper)';
21452252 123 package bar;
97b03d64
FC
124 is eval foo, 44, 'calling state sub from another package';
125 is eval &foo, 44, 'calling state sub from another package (amper)';
21452252 126}
21452252
FC
127package bar;
128is foo, 43, 'state sub falling out of scope';
129is &foo, 43, 'state sub falling out of scope (called via amper)';
21452252
FC
130{
131 sub sa { 43 }
132 state sub sa {
133 if (shift) {
134 is sa, 43, 'state sub invisible inside itself';
135 is &sa, 43, 'state sub invisible inside itself (called via amper)';
21452252
FC
136 }
137 44
138 }
21452252 139 sa(1);
21452252
FC
140 sub sb { 43 }
141 state sub sb;
142 state sub sb {
143 if (shift) {
144 # ‘state sub foo{}’ creates a new pad entry, not reusing the forward
145 # declaration. Being invisible inside itself, it sees the stub.
146 eval{sb};
147 like $@, qr/^Undefined subroutine &sb called at /,
148 'state sub foo {} after forward declaration';
149 eval{&sb};
150 like $@, qr/^Undefined subroutine &sb called at /,
151 'state sub foo {} after forward declaration (amper)';
21452252
FC
152 }
153 44
154 }
21452252 155 sb(1);
21452252
FC
156 sub sb2 { 43 }
157 state sub sb2;
158 sub sb2 {
159 if (shift) {
160 package bar;
97b03d64
FC
161 is sb2, 44, 'state sub visible inside itself after decl';
162 is &sb2, 44, 'state sub visible inside itself after decl (amper)';
21452252
FC
163 }
164 44
165 }
21452252 166 sb2(1);
21452252
FC
167 state sub sb3;
168 {
169 state sub sb3 { # new pad entry
170 # The sub containing this comment is invisible inside itself.
171 # So this one here will assign to the outer pad entry:
172 sub sb3 { 47 }
173 }
174 }
21452252
FC
175 is eval{sb3}, 47,
176 'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
10342479
FC
177 # Same test again, but inside an anonymous sub
178 sub {
179 state sub sb4;
180 {
181 state sub sb4 {
182 sub sb4 { 47 }
183 }
184 }
185 is sb4, 47,
186 'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
187 }->();
21452252
FC
188}
189sub sc { 43 }
190{
191 state sub sc;
192 eval{sc};
251a11d5 193 like $@, qr/^Undefined subroutine &sc called at /,
21452252
FC
194 'state sub foo; makes no lex alias for existing sub';
195 eval{&sc};
251a11d5 196 like $@, qr/^Undefined subroutine &sc called at /,
21452252 197 'state sub foo; makes no lex alias for existing sub (amper)';
21452252
FC
198}
199package main;
200{
201 state sub se ($);
202 is prototype eval{\&se}, '$', 'state sub with proto';
21452252
FC
203 is prototype "se", undef, 'prototype "..." ignores state subs';
204}
205{
206 state sub if() { 44 }
207 my $x = if if if;
208 is $x, 44, 'state subs override all keywords';
209 package bar;
210 my $y = if if if;
211 is $y, 44, 'state subs from other packages override all keywords';
212}
213{
64fbf0dd 214 use warnings; no warnings "experimental::lexical_subs";
21452252
FC
215 state $w ;
216 local $SIG{__WARN__} = sub { $w .= shift };
217 eval '#line 87 squidges
218 state sub foo;
219 state sub foo {};
220 ';
21452252 221 is $w,
4eb94d7c 222 '"state" subroutine &foo masks earlier declaration in same scope at '
21452252 223 . "squidges line 88.\n",
4eb94d7c 224 'warning for state sub masking earlier declaration';
21452252
FC
225}
226# Since state vars inside anonymous subs are cloned at the same time as the
227# anonymous subs containing them, the same should happen for state subs.
228sub make_closure {
e07561e6 229 my $x = shift;
21452252
FC
230 sub {
231 state sub foo { $x }
e07561e6 232 foo
21452252
FC
233 }
234}
235$sub1 = make_closure 48;
236$sub2 = make_closure 49;
237is &$sub1, 48, 'state sub in closure (1)';
97b03d64 238is &$sub2, 49, 'state sub in closure (2)';
21452252
FC
239# But we need to test that state subs actually do persist from one invoca-
240# tion of a named sub to another (i.e., that they are not my subs).
241{
64fbf0dd 242 use warnings; no warnings "experimental::lexical_subs";
21452252
FC
243 state $w;
244 local $SIG{__WARN__} = sub { $w .= shift };
245 eval '#line 65 teetet
246 sub foom {
247 my $x = shift;
248 state sub poom { $x }
249 eval{\&poom}
250 }
251 ';
252 is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
253 'state subs get "Variable will not stay shared" messages';
254 my $poom = foom(27);
255 my $poom2 = foom(678);
256 is eval{$poom->()}, eval {$poom2->()},
257 'state subs close over the first outer my var, like pkg subs';
258 my $x = 43;
259 for $x (765) {
260 state sub etetetet { $x }
c8e83515 261 is eval{etetetet}, 43, 'state sub ignores for() localisation';
21452252
FC
262 }
263}
e07561e6
FC
264# And we also need to test that multiple state subs can close over each
265# other’s entries in the parent subs pad, and that cv_clone is not con-
266# fused by that.
267sub make_anon_with_state_sub{
268 sub {
269 state sub s1;
270 state sub s2 { \&s1 }
271 sub s1 { \&s2 }
272 if (@_) { return \&s1 }
273 is s1,\&s2, 'state sub in anon closure closing over sibling state sub';
274 is s2,\&s1, 'state sub in anon closure closing over sibling state sub';
275 }
276}
277{
278 my $s = make_anon_with_state_sub;
279 &$s;
280
281 # And make sure the state subs were actually cloned.
282 isnt make_anon_with_state_sub->(0), &$s(0),
283 'state subs in anon subs are cloned';
284 is &$s(0), &$s(0), 'but only when the anon sub is cloned';
285}
21452252
FC
286{
287 state sub BEGIN { exit };
288 pass 'state subs are never special blocks';
289 state sub END { shift }
21452252
FC
290 is eval{END('jkqeudth')}, jkqeudth,
291 'state sub END {shift} implies @_, not @ARGV';
a96df643
FC
292 state sub CORE { scalar reverse shift }
293 is CORE::uc("hello"), "HELLO",
294 'lexical CORE does not interfere with CORE::...';
21452252
FC
295}
296{
297 state sub redef {}
64fbf0dd 298 use warnings; no warnings "experimental::lexical_subs";
21452252
FC
299 state $w;
300 local $SIG{__WARN__} = sub { $w .= shift };
301 eval "#line 56 pygpyf\nsub redef {}";
302 is $w, "Subroutine redef redefined at pygpyf line 56.\n",
303 "sub redefinition warnings from state subs";
304}
279d09bf
FC
305{
306 state sub p (\@) {
307 is ref $_[0], 'ARRAY', 'state sub with proto';
308 }
309 p(my @a);
9a5e6f3c 310 p my @b;
83a72a15
FC
311 state sub q () { 45 }
312 is q(), 45, 'state constant called with parens';
279d09bf 313}
c388b213
FC
314{
315 state sub x;
316 eval 'sub x {3}';
317 is x, 3, 'state sub defined inside eval';
a70c2d56
FC
318
319 sub r {
320 state sub foo { 3 };
321 if (@_) { # outer call
322 r();
323 is foo(), 42,
324 'state sub run-time redefinition applies to all recursion levels';
325 }
326 else { # inner call
327 eval 'sub foo { 42 }';
328 }
329 }
330 r(1);
c388b213 331}
fe54d63b 332like runperl(
30d9c59b 333 switches => [ '-Mfeature=lexical_subs,state' ],
fe54d63b
FC
334 prog => 'state sub a { foo ref } a()',
335 stderr => 1
336 ),
337 qr/syntax error/,
338 'referencing a state sub after a syntax error does not crash';
18691622
FC
339{
340 state $stuff;
341 package A {
342 state sub foo{ $stuff .= our $AUTOLOAD }
343 *A::AUTOLOAD = \&foo;
344 }
345 A::bar();
346 is $stuff, 'A::bar', 'state sub assigned to *AUTOLOAD can autoload';
347}
56117e3e
FC
348{
349 state sub quire{qr "quires"}
350 package o { use overload qr => \&quire }
351 ok "quires" =~ bless([], o::), 'state sub used as overload method';
352}
db5cc3ee
FC
353{
354 state sub foo;
355 *cvgv = \&foo;
356 local *cvgv2 = *cvgv;
357 eval 'sub cvgv2 {42}'; # uses the stub already present
358 is foo, 42, 'defining state sub body via package sub declaration';
359}
9d8e4b9b
FC
360{
361 local $ENV{PERL5DB} = 'sub DB::DB{}';
362 is(
363 runperl(
364 switches => [ '-d' ],
365 progs => [ split "\n",
366 'use feature qw - lexical_subs state -;
367 no warnings q-experimental::lexical_subs-;
368 sub DB::sub{ print qq|4\n|; goto $DB::sub }
369 state sub foo {print qq|2\n|}
370 foo();
371 '
372 ],
373 stderr => 1
374 ),
375 "4\n2\n",
376 'state subs and DB::sub under -d'
377 );
378}
7fcb4126
FC
379# This used to fail an assertion, but only as a standalone script
380is runperl(switches => ['-lXMfeature=:all'],
381 prog => 'state sub x {}; undef &x; print defined &x',
382 stderr => 1), "\n", 'undefining state sub';
a5f47741
FC
383{
384 state sub x { is +(caller 0)[3], 'x', 'state sub name in caller' }
385 x
386}
1402e1eb
FC
387sub _cmp { $a cmp $b }
388{
389 local $::TODO = ' ';
390 state sub _cmp { $b cmp $a }
391 is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
392 'sort state_sub LIST'
393}
dffc5024
FC
394{
395 state sub handel { "" }
396 print handel, "ok ", curr_test(),
397 " - no 'No comma allowed' after state sub\n";
398 curr_test(curr_test()+1);
399}
194774c2
FC
400
401# -------------------- my -------------------- #
402
403{
404 my sub foo { 44 }
405 isnt \&::foo, \&foo, 'my sub is not stored in the package';
406 is foo, 44, 'calling my sub from same package';
407 is &foo, 44, 'calling my sub from same package (amper)';
194774c2
FC
408 package bar;
409 is foo, 44, 'calling my sub from another package';
410 is &foo, 44, 'calling my sub from another package (amper)';
194774c2
FC
411}
412package bar;
413is foo, 43, 'my sub falling out of scope';
414is &foo, 43, 'my sub falling out of scope (called via amper)';
194774c2
FC
415{
416 sub ma { 43 }
417 my sub ma {
418 if (shift) {
419 is ma, 43, 'my sub invisible inside itself';
420 is &ma, 43, 'my sub invisible inside itself (called via amper)';
194774c2
FC
421 }
422 44
423 }
424 ma(1);
425 sub mb { 43 }
426 my sub mb;
427 my sub mb {
428 if (shift) {
429 # ‘my sub foo{}’ creates a new pad entry, not reusing the forward
430 # declaration. Being invisible inside itself, it sees the stub.
431 eval{mb};
432 like $@, qr/^Undefined subroutine &mb called at /,
433 'my sub foo {} after forward declaration';
434 eval{&mb};
435 like $@, qr/^Undefined subroutine &mb called at /,
436 'my sub foo {} after forward declaration (amper)';
194774c2
FC
437 }
438 44
439 }
440 mb(1);
441 sub mb2 { 43 }
442 my sub sb2;
443 sub mb2 {
444 if (shift) {
445 package bar;
446 is mb2, 44, 'my sub visible inside itself after decl';
447 is &mb2, 44, 'my sub visible inside itself after decl (amper)';
194774c2
FC
448 }
449 44
450 }
451 mb2(1);
452 my sub mb3;
453 {
454 my sub mb3 { # new pad entry
455 # The sub containing this comment is invisible inside itself.
456 # So this one here will assign to the outer pad entry:
457 sub mb3 { 47 }
458 }
459 }
460 is eval{mb3}, 47,
461 'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
10342479
FC
462 # Same test again, but inside an anonymous sub
463 sub {
464 my sub mb4;
465 {
466 my sub mb4 {
467 sub mb4 { 47 }
468 }
469 }
470 is mb4, 47,
471 'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
472 }->();
194774c2
FC
473}
474sub mc { 43 }
475{
476 my sub mc;
477 eval{mc};
478 like $@, qr/^Undefined subroutine &mc called at /,
479 'my sub foo; makes no lex alias for existing sub';
480 eval{&mc};
481 like $@, qr/^Undefined subroutine &mc called at /,
482 'my sub foo; makes no lex alias for existing sub (amper)';
194774c2
FC
483}
484package main;
485{
486 my sub me ($);
487 is prototype eval{\&me}, '$', 'my sub with proto';
488 is prototype "me", undef, 'prototype "..." ignores my subs';
fdf416b6
BF
489
490 my $coderef = eval "my sub foo (\$\x{30cd}) {1}; \\&foo";
491 my $proto = prototype $coderef;
492 ok(utf8::is_utf8($proto), "my sub with UTF8 proto maintains the UTF8ness");
72e8be86 493 is($proto, "\$\x{30cd}", "check the prototypes actually match");
194774c2
FC
494}
495{
496 my sub if() { 44 }
497 my $x = if if if;
498 is $x, 44, 'my subs override all keywords';
499 package bar;
500 my $y = if if if;
501 is $y, 44, 'my subs from other packages override all keywords';
502}
503{
64fbf0dd 504 use warnings; no warnings "experimental::lexical_subs";
194774c2
FC
505 my $w ;
506 local $SIG{__WARN__} = sub { $w .= shift };
507 eval '#line 87 squidges
508 my sub foo;
509 my sub foo {};
510 ';
511 is $w,
512 '"my" subroutine &foo masks earlier declaration in same scope at '
513 . "squidges line 88.\n",
514 'warning for my sub masking earlier declaration';
515}
516# Test that my subs are cloned inside anonymous subs.
517sub mmake_closure {
518 my $x = shift;
519 sub {
520 my sub foo { $x }
521 foo
522 }
523}
524$sub1 = mmake_closure 48;
525$sub2 = mmake_closure 49;
6d5c2147
FC
526is &$sub1, 48, 'my sub in closure (1)';
527is &$sub2, 49, 'my sub in closure (2)';
194774c2
FC
528# Test that they are cloned in named subs.
529{
64fbf0dd 530 use warnings; no warnings "experimental::lexical_subs";
194774c2
FC
531 my $w;
532 local $SIG{__WARN__} = sub { $w .= shift };
533 eval '#line 65 teetet
6d5c2147 534 sub mfoom {
194774c2
FC
535 my $x = shift;
536 my sub poom { $x }
6d5c2147 537 \&poom
194774c2
FC
538 }
539 ';
540 is $w, undef, 'my subs get no "Variable will not stay shared" messages';
6d5c2147
FC
541 my $poom = mfoom(27);
542 my $poom2 = mfoom(678);
543 is $poom->(), 27, 'my subs closing over outer my var (1)';
544 is $poom2->(), 678, 'my subs closing over outer my var (2)';
194774c2
FC
545 my $x = 43;
546 my sub aoeu;
547 for $x (765) {
548 my sub etetetet { $x }
6d5c2147 549 sub aoeu { $x }
194774c2 550 is etetetet, 765, 'my sub respects for() localisation';
194774c2
FC
551 is aoeu, 43, 'unless it is declared outside the for loop';
552 }
553}
554# And we also need to test that multiple my subs can close over each
555# other’s entries in the parent subs pad, and that cv_clone is not con-
556# fused by that.
557sub make_anon_with_my_sub{
558 sub {
559 my sub s1;
560 my sub s2 { \&s1 }
561 sub s1 { \&s2 }
562 if (@_) { return eval { \&s1 } }
563 is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub';
564 is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub';
565 }
566}
0afba48f
FC
567
568# Test my subs inside predeclared my subs
569{
570 my sub s2;
571 sub s2 {
572 my $x = 3;
573 my sub s3 { eval '$x' }
574 s3;
575 }
0afba48f
FC
576 is s2, 3, 'my sub inside predeclared my sub';
577}
578
194774c2
FC
579{
580 my $s = make_anon_with_my_sub;
581 &$s;
582
583 # And make sure the my subs were actually cloned.
194774c2
FC
584 isnt make_anon_with_my_sub->(0), &$s(0),
585 'my subs in anon subs are cloned';
586 isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub';
194774c2
FC
587}
588{
589 my sub BEGIN { exit };
590 pass 'my subs are never special blocks';
591 my sub END { shift }
592 is END('jkqeudth'), jkqeudth,
593 'my sub END {shift} implies @_, not @ARGV';
594}
595{
596 my sub redef {}
64fbf0dd 597 use warnings; no warnings "experimental::lexical_subs";
194774c2
FC
598 my $w;
599 local $SIG{__WARN__} = sub { $w .= shift };
600 eval "#line 56 pygpyf\nsub redef {}";
601 is $w, "Subroutine redef redefined at pygpyf line 56.\n",
602 "sub redefinition warnings from my subs";
4e85e1b4
FC
603
604 undef $w;
605 sub {
606 my sub x {};
607 sub { eval "#line 87 khaki\n\\&x" }
608 }->()();
609 is $w, "Subroutine \"&x\" is not available at khaki line 87.\n",
610 "unavailability warning during compilation of eval in closure";
611
612 undef $w;
613 no warnings 'void';
614 eval <<'->()();';
615#line 87 khaki
616 sub {
617 my sub x{}
618 sub not_lexical8 {
619 \&x
620 }
621 }
622->()();
623 is $w, "Subroutine \"&x\" is not available at khaki line 90.\n",
624 "unavailability warning during compilation of named sub in anon";
cf748c3c
FC
625
626 undef $w;
627 sub not_lexical9 {
628 my sub x {};
629 format =
630@
631&x
632.
633 }
634 eval { write };
635 my($f,$l) = (__FILE__,__LINE__ - 1);
636 is $w, "Subroutine \"&x\" is not available at $f line $l.\n",
637 'unavailability warning during cloning';
638 $l -= 3;
639 is $@, "Undefined subroutine &x called at $f line $l.\n",
640 'Vivified sub is correctly named';
194774c2 641}
ebfebee4
FC
642sub not_lexical10 {
643 my sub foo;
644 foo();
645 sub not_lexical11 {
646 my sub bar {
647 my $x = 'khaki car keys for the khaki car';
648 not_lexical10();
649 sub foo {
650 is $x, 'khaki car keys for the khaki car',
651 'mysubs in inner clonables use the running clone of their CvOUTSIDE'
652 }
653 }
654 bar()
655 }
656}
657not_lexical11();
279d09bf
FC
658{
659 my sub p (\@) {
660 is ref $_[0], 'ARRAY', 'my sub with proto';
661 }
662 p(my @a);
9a5e6f3c 663 p @a;
83a72a15
FC
664 my sub q () { 46 }
665 is q(), 46, 'my constant called with parens';
279d09bf
FC
666}
667{
668 my sub x;
669 my $count;
670 sub x { x() if $count++ < 10 }
671 x();
672 is $count, 11, 'my recursive subs';
673}
a70c2d56
FC
674{
675 my sub x;
676 eval 'sub x {3}';
677 is x, 3, 'my sub defined inside eval';
678}
6d5c2147 679
4ded55f3
FC
680{
681 state $w;
682 local $SIG{__WARN__} = sub { $w .= shift };
683 eval q{ my sub george () { 2 } };
684 is $w, undef, 'no double free from constant my subs';
685}
fe54d63b 686like runperl(
30d9c59b 687 switches => [ '-Mfeature=lexical_subs,state' ],
fe54d63b
FC
688 prog => 'my sub a { foo ref } a()',
689 stderr => 1
690 ),
691 qr/syntax error/,
692 'referencing a my sub after a syntax error does not crash';
18691622
FC
693{
694 state $stuff;
695 package A {
696 my sub foo{ $stuff .= our $AUTOLOAD }
697 *A::AUTOLOAD = \&foo;
698 }
699 A::bar();
700 is $stuff, 'A::bar', 'my sub assigned to *AUTOLOAD can autoload';
701}
56117e3e
FC
702{
703 my sub quire{qr "quires"}
704 package mo { use overload qr => \&quire }
705 ok "quires" =~ bless([], mo::), 'my sub used as overload method';
706}
db5cc3ee
FC
707{
708 my sub foo;
709 *mcvgv = \&foo;
710 local *mcvgv2 = *mcvgv;
711 eval 'sub mcvgv2 {42}'; # uses the stub already present
712 is foo, 42, 'defining my sub body via package sub declaration';
713}
714{
715 my sub foo;
716 *mcvgv3 = \&foo;
717 local *mcvgv4 = *mcvgv3;
718 eval 'sub mcvgv4 {42}'; # uses the stub already present
719 undef *mcvgv3; undef *mcvgv4; # leaves the pad with the only reference
720}
721# We would have crashed by now if it weren’t fixed.
722pass "pad taking ownership once more of packagified my-sub";
4ded55f3 723
9d8e4b9b
FC
724{
725 local $ENV{PERL5DB} = 'sub DB::DB{}';
726 is(
727 runperl(
728 switches => [ '-d' ],
729 progs => [ split "\n",
730 'use feature qw - lexical_subs state -;
731 no warnings q-experimental::lexical_subs-;
732 sub DB::sub{ print qq|4\n|; goto $DB::sub }
733 my sub foo {print qq|2\n|}
734 foo();
735 '
736 ],
737 stderr => 1
738 ),
739 "4\n2\n",
740 'my subs and DB::sub under -d'
741 );
742}
7fcb4126
FC
743# This used to fail an assertion, but only as a standalone script
744is runperl(switches => ['-lXMfeature=:all'],
745 prog => 'my sub x {}; undef &x; print defined &x',
746 stderr => 1), "\n", 'undefining my sub';
a5f47741
FC
747{
748 my sub x { is +(caller 0)[3], 'x', 'my sub name in caller' }
749 x
750}
1402e1eb
FC
751{
752 local $::TODO = ' ';
753 my sub _cmp { $b cmp $a }
754 is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
755 'sort my_sub LIST'
756}
dffc5024
FC
757{
758 my sub handel { "" }
759 print handel,"ok ",curr_test()," - no 'No comma allowed' after my sub\n";
760 curr_test(curr_test()+1);
761}
9d8e4b9b 762
6d5c2147
FC
763# -------------------- Interactions (and misc tests) -------------------- #
764
765is sub {
766 my sub s1;
767 my sub s2 { 3 };
768 sub s1 { state sub foo { \&s2 } foo }
769 s1
770 }->()(), 3, 'state sub inside my sub closing over my sub uncle';
771
0afba48f
FC
772{
773 my sub s2 { 3 };
774 sub not_lexical { state sub foo { \&s2 } foo }
775 is not_lexical->(), 3, 'state subs that reference my sub from outside';
776}
777
778# Test my subs inside predeclared package subs
779# This test also checks that CvOUTSIDE pointers are not mangled when the
780# inner sub’s CvOUTSIDE points to another sub.
781sub not_lexical2;
782sub not_lexical2 {
783 my $x = 23;
784 my sub bar;
785 sub not_lexical3 {
786 not_lexical2();
787 sub bar { $x }
788 };
789 bar
790}
0afba48f
FC
791is not_lexical3, 23, 'my subs inside predeclared package subs';
792
793# Test my subs inside predeclared package sub, where the lexical sub is
794# declared outside the package sub.
795# This checks that CvOUTSIDE pointers are fixed up even when the sub is
796# not declared inside the sub that its CvOUTSIDE points to.
8d88fe29 797sub not_lexical5 {
0afba48f
FC
798 my sub foo;
799 sub not_lexical4;
800 sub not_lexical4 {
801 my $x = 234;
8d88fe29 802 not_lexical5();
0afba48f 803 sub foo { $x }
0afba48f 804 }
8d88fe29 805 foo
0afba48f 806}
8d88fe29
FC
807is not_lexical4, 234,
808 'my sub defined in predeclared pkg sub but declared outside';
1f122f9b
FC
809
810undef *not_lexical6;
811{
812 my sub foo;
813 sub not_lexical6 { sub foo { } }
814 pass 'no crash when cloning a mysub declared inside an undef pack sub';
815}
9ccc915e
FC
816
817undef &not_lexical7;
818eval 'sub not_lexical7 { my @x }';
819{
820 my sub foo;
821 foo();
822 sub not_lexical7 {
823 state $x;
824 sub foo {
825 is ref \$x, 'SCALAR',
826 "redeffing a mysub's outside does not make it use the wrong pad"
827 }
828 }
829}
07b2687d
LM
830
831like runperl(
30d9c59b 832 switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
07b2687d
LM
833 prog => 'my sub foo; sub foo { foo } foo',
834 stderr => 1
835 ),
836 qr/Deep recursion on subroutine "foo"/,
837 'deep recursion warnings for lexical subs do not crash';
bdbfc51a
FC
838
839like runperl(
30d9c59b 840 switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
bdbfc51a
FC
841 prog => 'my sub foo() { 42 } undef &foo',
842 stderr => 1
843 ),
844 qr/Constant subroutine foo undefined at /,
845 'constant undefinition warnings for lexical subs do not crash';
8bfda0d7
FC
846
847{
848 my sub foo;
849 *AutoloadTestSuper::blah = \&foo;
850 sub AutoloadTestSuper::AUTOLOAD {
851 is $AutoloadTestSuper::AUTOLOAD, "AutoloadTestSuper::blah",
852 "Autoloading via inherited lex stub";
853 }
854 @AutoloadTest::ISA = AutoloadTestSuper::;
855 AutoloadTest->blah;
856}