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