This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test preamble: unify chdir 't' if -d 't';
[perl5.git] / t / op / lexsub.t
1 #!perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7     *bar::is = *is;
8     *bar::like = *like;
9 }
10 plan 143;
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';
23
24 # -------------------- our -------------------- #
25
26 no warnings "experimental::lexical_subs";
27 use feature 'lexical_subs';
28 {
29   our sub foo { 42 }
30   is foo, 42, 'calling our sub from same package';
31   is &foo, 42, 'calling our sub from same package (amper)';
32   package bar;
33   sub bar::foo { 43 }
34   is foo, 42, 'calling our sub from another package';
35   is &foo, 42, 'calling our sub from another package (amper)';
36 }
37 package bar;
38 is foo, 43, 'our sub falling out of scope';
39 is &foo, 43, 'our sub falling out of scope (called via amper)';
40 package main;
41 {
42   sub bar::a { 43 }
43   our sub a {
44     if (shift) {
45       package bar;
46       is a, 43, 'our sub invisible inside itself';
47       is &a, 43, 'our sub invisible inside itself (called via amper)';
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;
57       is b, 42, 'our sub visible inside itself after decl';
58       is &b, 42, 'our sub visible inside itself after decl (amper)';
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;
69   is c, 42, 'our sub foo; makes lex alias for existing sub';
70   is &c, 42, 'our sub foo; makes lex alias for existing sub (amper)';
71 }
72 {
73   our sub d;
74   sub bar::d { 'd43' }
75   package bar;
76   sub d { 'd42' }
77   is eval ::d, 'd42', 'our sub foo; applies to subsequent sub foo {}';
78 }
79 {
80   our sub e ($);
81   is prototype "::e", '$', 'our sub with proto';
82 }
83 {
84   our sub if() { 42 }
85   my $x = if if if;
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';
90 }
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 }
99 # our sub and method confusion
100 sub 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 }
111 our sub j;
112 is j
113   =>, 'j', 'name_of_our_sub <newline> =>  is parsed properly';
114 sub _cmp { $a cmp $b }
115 sub 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 }
122
123 # -------------------- state -------------------- #
124
125 use feature 'state'; # state
126 {
127   state sub foo { 44 }
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)';
131   package bar;
132   is eval foo, 44, 'calling state sub from another package';
133   is eval &foo, 44, 'calling state sub from another package (amper)';
134 }
135 package bar;
136 is foo, 43, 'state sub falling out of scope';
137 is &foo, 43, 'state sub falling out of scope (called via amper)';
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)';
144     }
145     44
146   }
147   sa(1);
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)';
160     }
161     44
162   }
163   sb(1);
164   sub sb2 { 43 }
165   state sub sb2;
166   sub sb2 {
167     if (shift) {
168       package bar;
169       is sb2, 44, 'state sub visible inside itself after decl';
170       is &sb2, 44, 'state sub visible inside itself after decl (amper)';
171     }
172     44
173   }
174   sb2(1);
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   }
183   is eval{sb3}, 47,
184     'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
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   }->();
196 }
197 sub sc { 43 }
198 {
199   state sub sc;
200   eval{sc};
201   like $@, qr/^Undefined subroutine &sc called at /,
202      'state sub foo; makes no lex alias for existing sub';
203   eval{&sc};
204   like $@, qr/^Undefined subroutine &sc called at /,
205      'state sub foo; makes no lex alias for existing sub (amper)';
206 }
207 package main;
208 {
209   state sub se ($);
210   is prototype eval{\&se}, '$', 'state sub with proto';
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 {
222   use warnings; no warnings "experimental::lexical_subs";
223   state $w ;
224   local $SIG{__WARN__} = sub { $w .= shift };
225   eval '#line 87 squidges
226     state sub foo;
227     state sub foo {};
228   ';
229   is $w,
230      '"state" subroutine &foo masks earlier declaration in same scope at '
231    . "squidges line 88.\n",
232      'warning for state sub masking earlier declaration';
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.
236 sub make_closure {
237   my $x = shift;
238   sub {
239     state sub foo { $x }
240     foo
241   }
242 }
243 $sub1 = make_closure 48;
244 $sub2 = make_closure 49;
245 is &$sub1, 48, 'state sub in closure (1)';
246 is &$sub2, 49, 'state sub in closure (2)';
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 {
250   use warnings; no warnings "experimental::lexical_subs";
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 }
269     is eval{etetetet}, 43, 'state sub ignores for() localisation';
270   }
271 }
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.
275 sub 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 }
294 {
295   state sub BEGIN { exit };
296   pass 'state subs are never special blocks';
297   state sub END { shift }
298   is eval{END('jkqeudth')}, jkqeudth,
299     'state sub END {shift} implies @_, not @ARGV';
300   state sub CORE { scalar reverse shift }
301   is CORE::uc("hello"), "HELLO",
302     'lexical CORE does not interfere with CORE::...';
303 }
304 {
305   state sub redef {}
306   use warnings; no warnings "experimental::lexical_subs";
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 }
313 {
314   state sub p (\@) {
315     is ref $_[0], 'ARRAY', 'state sub with proto';
316   }
317   p(my @a);
318   p my @b;
319   state sub q () { 45 }
320   is q(), 45, 'state constant called with parens';
321 }
322 {
323   state sub x;
324   eval 'sub x {3}';
325   is x, 3, 'state sub defined inside eval';
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);
339 }
340 like runperl(
341       switches => [ '-Mfeature=lexical_subs,state' ],
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';
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 }
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 }
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 }
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   is(
387     runperl(
388      switches => [ '-d' ],
389      progs => [ split "\n",
390       'use feature qw - lexical_subs state -;
391        no warnings q-experimental::lexical_subs-;
392        sub DB::goto{ print qq|4\n|; $_ = $DB::sub }
393        state sub foo {print qq|2\n|}
394        $^P|=0x80;
395        sub { goto &foo }->();
396        print $_ == \&foo ? qq|ok\n| : qq|$_\n|;
397       '
398      ],
399      stderr => 1
400     ),
401     "4\n2\nok\n",
402     'state subs and DB::goto under -d'
403   );
404 }
405 # This used to fail an assertion, but only as a standalone script
406 is runperl(switches => ['-lXMfeature=:all'],
407            prog     => 'state sub x {}; undef &x; print defined &x',
408            stderr   => 1), "\n", 'undefining state sub';
409 {
410   state sub x { is +(caller 0)[3], 'x', 'state sub name in caller' }
411   x
412 }
413 {
414   state sub _cmp { $b cmp $a }
415   is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
416     'sort state_sub LIST'
417 }
418 {
419   state sub handel { "" }
420   print handel, "ok ", curr_test(),
421        " - no 'No comma allowed' after state sub\n";
422   curr_test(curr_test()+1);
423 }
424
425 # -------------------- my -------------------- #
426
427 {
428   my sub foo { 44 }
429   isnt \&::foo, \&foo, 'my sub is not stored in the package';
430   is foo, 44, 'calling my sub from same package';
431   is &foo, 44, 'calling my sub from same package (amper)';
432   package bar;
433   is foo, 44, 'calling my sub from another package';
434   is &foo, 44, 'calling my sub from another package (amper)';
435 }
436 package bar;
437 is foo, 43, 'my sub falling out of scope';
438 is &foo, 43, 'my sub falling out of scope (called via amper)';
439 {
440   sub ma { 43 }
441   my sub ma {
442     if (shift) {
443       is ma, 43, 'my sub invisible inside itself';
444       is &ma, 43, 'my sub invisible inside itself (called via amper)';
445     }
446     44
447   }
448   ma(1);
449   sub mb { 43 }
450   my sub mb;
451   my sub mb {
452     if (shift) {
453       # ‘my sub foo{}’ creates a new pad entry, not reusing the forward
454       #  declaration.  Being invisible inside itself, it sees the stub.
455       eval{mb};
456       like $@, qr/^Undefined subroutine &mb called at /,
457         'my sub foo {} after forward declaration';
458       eval{&mb};
459       like $@, qr/^Undefined subroutine &mb called at /,
460         'my sub foo {} after forward declaration (amper)';
461     }
462     44
463   }
464   mb(1);
465   sub mb2 { 43 }
466   my sub sb2;
467   sub mb2 {
468     if (shift) {
469       package bar;
470       is mb2, 44, 'my sub visible inside itself after decl';
471       is &mb2, 44, 'my sub visible inside itself after decl (amper)';
472     }
473     44
474   }
475   mb2(1);
476   my sub mb3;
477   {
478     my sub mb3 { # new pad entry
479       # The sub containing this comment is invisible inside itself.
480       # So this one here will assign to the outer pad entry:
481       sub mb3 { 47 }
482     }
483   }
484   is eval{mb3}, 47,
485     'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
486   # Same test again, but inside an anonymous sub
487   sub {
488     my sub mb4;
489     {
490       my sub mb4 {
491         sub mb4 { 47 }
492       }
493     }
494     is mb4, 47,
495       'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
496   }->();
497 }
498 sub mc { 43 }
499 {
500   my sub mc;
501   eval{mc};
502   like $@, qr/^Undefined subroutine &mc called at /,
503      'my sub foo; makes no lex alias for existing sub';
504   eval{&mc};
505   like $@, qr/^Undefined subroutine &mc called at /,
506      'my sub foo; makes no lex alias for existing sub (amper)';
507 }
508 package main;
509 {
510   my sub me ($);
511   is prototype eval{\&me}, '$', 'my sub with proto';
512   is prototype "me", undef, 'prototype "..." ignores my subs';
513
514   my $coderef = eval "my sub foo (\$\x{30cd}) {1}; \\&foo";
515   my $proto = prototype $coderef;
516   ok(utf8::is_utf8($proto), "my sub with UTF8 proto maintains the UTF8ness");
517   is($proto, "\$\x{30cd}", "check the prototypes actually match");
518 }
519 {
520   my sub if() { 44 }
521   my $x = if if if;
522   is $x, 44, 'my subs override all keywords';
523   package bar;
524   my $y = if if if;
525   is $y, 44, 'my subs from other packages override all keywords';
526 }
527 {
528   use warnings; no warnings "experimental::lexical_subs";
529   my $w ;
530   local $SIG{__WARN__} = sub { $w .= shift };
531   eval '#line 87 squidges
532     my sub foo;
533     my sub foo {};
534   ';
535   is $w,
536      '"my" subroutine &foo masks earlier declaration in same scope at '
537    . "squidges line 88.\n",
538      'warning for my sub masking earlier declaration';
539 }
540 # Test that my subs are cloned inside anonymous subs.
541 sub mmake_closure {
542   my $x = shift;
543   sub {
544     my sub foo { $x }
545     foo
546   }
547 }
548 $sub1 = mmake_closure 48;
549 $sub2 = mmake_closure 49;
550 is &$sub1, 48, 'my sub in closure (1)';
551 is &$sub2, 49, 'my sub in closure (2)';
552 # Test that they are cloned in named subs.
553 {
554   use warnings; no warnings "experimental::lexical_subs";
555   my $w;
556   local $SIG{__WARN__} = sub { $w .= shift };
557   eval '#line 65 teetet
558     sub mfoom {
559       my $x = shift;
560       my sub poom { $x }
561       \&poom
562     }
563   ';
564   is $w, undef, 'my subs get no "Variable will not stay shared" messages';
565   my $poom = mfoom(27);
566   my $poom2 = mfoom(678);
567   is $poom->(), 27, 'my subs closing over outer my var (1)';
568   is $poom2->(), 678, 'my subs closing over outer my var (2)';
569   my $x = 43;
570   my sub aoeu;
571   for $x (765) {
572     my sub etetetet { $x }
573     sub aoeu { $x }
574     is etetetet, 765, 'my sub respects for() localisation';
575     is aoeu, 43, 'unless it is declared outside the for loop';
576   }
577 }
578 # And we also need to test that multiple my subs can close over each
579 # other’s entries in the parent subs pad, and that cv_clone is not con-
580 # fused by that.
581 sub make_anon_with_my_sub{
582   sub {
583     my sub s1;
584     my sub s2 { \&s1 }
585     sub s1 { \&s2 }
586     if (@_) { return eval { \&s1 } }
587     is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub';
588     is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub';
589   }
590 }
591
592 # Test my subs inside predeclared my subs
593 {
594   my sub s2;
595   sub s2 {
596     my $x = 3;
597     my sub s3 { eval '$x' }
598     s3;
599   }
600   is s2, 3, 'my sub inside predeclared my sub';
601 }
602
603 {
604   my $s = make_anon_with_my_sub;
605   &$s;
606
607   # And make sure the my subs were actually cloned.
608   isnt make_anon_with_my_sub->(0), &$s(0),
609     'my subs in anon subs are cloned';
610   isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub';
611 }
612 {
613   my sub BEGIN { exit };
614   pass 'my subs are never special blocks';
615   my sub END { shift }
616   is END('jkqeudth'), jkqeudth,
617     'my sub END {shift} implies @_, not @ARGV';
618 }
619 {
620   my sub redef {}
621   use warnings; no warnings "experimental::lexical_subs";
622   my $w;
623   local $SIG{__WARN__} = sub { $w .= shift };
624   eval "#line 56 pygpyf\nsub redef {}";
625   is $w, "Subroutine redef redefined at pygpyf line 56.\n",
626          "sub redefinition warnings from my subs";
627
628   undef $w;
629   sub {
630     my sub x {};
631     sub { eval "#line 87 khaki\n\\&x" }
632   }->()();
633   is $w, "Subroutine \"&x\" is not available at khaki line 87.\n",
634          "unavailability warning during compilation of eval in closure";
635
636   undef $w;
637   no warnings 'void';
638   eval <<'->()();';
639 #line 87 khaki
640     sub {
641       my sub x{}
642       sub not_lexical8 {
643         \&x
644       }
645     }
646 ->()();
647   is $w, "Subroutine \"&x\" is not available at khaki line 90.\n",
648          "unavailability warning during compilation of named sub in anon";
649
650   undef $w;
651   sub not_lexical9 {
652     my sub x {};
653     format =
654 @
655 &x
656 .
657   }
658   eval { write };
659   my($f,$l) = (__FILE__,__LINE__ - 1);
660   is $w, "Subroutine \"&x\" is not available at $f line $l.\n",
661          'unavailability warning during cloning';
662   $l -= 3;
663   is $@, "Undefined subroutine &x called at $f line $l.\n",
664          'Vivified sub is correctly named';
665 }
666 sub not_lexical10 {
667   my sub foo;
668   foo();
669   sub not_lexical11 {
670     my sub bar {
671       my $x = 'khaki car keys for the khaki car';
672       not_lexical10();
673       sub foo {
674        is $x, 'khaki car keys for the khaki car',
675        'mysubs in inner clonables use the running clone of their CvOUTSIDE'
676       }
677     }
678     bar()
679   }
680 }
681 not_lexical11();
682 {
683   my sub p (\@) {
684     is ref $_[0], 'ARRAY', 'my sub with proto';
685   }
686   p(my @a);
687   p @a;
688   my sub q () { 46 }
689   is q(), 46, 'my constant called with parens';
690 }
691 {
692   my sub x;
693   my $count;
694   sub x { x() if $count++ < 10 }
695   x();
696   is $count, 11, 'my recursive subs';
697 }
698 {
699   my sub x;
700   eval 'sub x {3}';
701   is x, 3, 'my sub defined inside eval';
702 }
703
704 {
705   state $w;
706   local $SIG{__WARN__} = sub { $w .= shift };
707   eval q{ my sub george () { 2 } };
708   is $w, undef, 'no double free from constant my subs';
709 }
710 like runperl(
711       switches => [ '-Mfeature=lexical_subs,state' ],
712       prog     => 'my sub a { foo ref } a()',
713       stderr   => 1
714      ),
715      qr/syntax error/,
716     'referencing a my sub after a syntax error does not crash';
717 {
718   state $stuff;
719   package A {
720     my sub foo{ $stuff .= our $AUTOLOAD }
721     *A::AUTOLOAD = \&foo;
722   }
723   A::bar();
724   is $stuff, 'A::bar', 'my sub assigned to *AUTOLOAD can autoload';
725 }
726 {
727   my sub quire{qr "quires"}
728   package mo { use overload qr => \&quire }
729   ok "quires" =~ bless([], mo::), 'my sub used as overload method';
730 }
731 {
732   my sub foo;
733   *mcvgv = \&foo;
734   local *mcvgv2 = *mcvgv;
735   eval 'sub mcvgv2 {42}'; # uses the stub already present
736   is foo, 42, 'defining my sub body via package sub declaration';
737 }
738 {
739   my sub foo;
740   *mcvgv3 = \&foo;
741   local *mcvgv4 = *mcvgv3;
742   eval 'sub mcvgv4 {42}'; # uses the stub already present
743   undef *mcvgv3; undef *mcvgv4; # leaves the pad with the only reference
744 }
745 # We would have crashed by now if it weren’t fixed.
746 pass "pad taking ownership once more of packagified my-sub";
747
748 {
749   local $ENV{PERL5DB} = 'sub DB::DB{}';
750   is(
751     runperl(
752      switches => [ '-d' ],
753      progs => [ split "\n",
754       'use feature qw - lexical_subs state -;
755        no warnings q-experimental::lexical_subs-;
756        sub DB::sub{ print qq|4\n|; goto $DB::sub }
757        my sub foo {print qq|2\n|}
758        foo();
759       '
760      ],
761      stderr => 1
762     ),
763     "4\n2\n",
764     'my subs and DB::sub under -d'
765   );
766 }
767 # This used to fail an assertion, but only as a standalone script
768 is runperl(switches => ['-lXMfeature=:all'],
769            prog     => 'my sub x {}; undef &x; print defined &x',
770            stderr   => 1), "\n", 'undefining my sub';
771 {
772   my sub x { is +(caller 0)[3], 'x', 'my sub name in caller' }
773   x
774 }
775 {
776   my sub _cmp { $b cmp $a }
777   is join(" ", sort _cmp split //, 'lexsub'), 'x u s l e b',
778     'sort my_sub LIST'
779 }
780 {
781   my sub handel { "" }
782   print handel,"ok ",curr_test()," - no 'No comma allowed' after my sub\n";
783   curr_test(curr_test()+1);
784 }
785
786 # -------------------- Interactions (and misc tests) -------------------- #
787
788 is sub {
789     my sub s1;
790     my sub s2 { 3 };
791     sub s1 { state sub foo { \&s2 } foo }
792     s1
793   }->()(), 3, 'state sub inside my sub closing over my sub uncle';
794
795 {
796   my sub s2 { 3 };
797   sub not_lexical { state sub foo { \&s2 } foo }
798   is not_lexical->(), 3, 'state subs that reference my sub from outside';
799 }
800
801 # Test my subs inside predeclared package subs
802 # This test also checks that CvOUTSIDE pointers are not mangled when the
803 # inner sub’s CvOUTSIDE points to another sub.
804 sub not_lexical2;
805 sub not_lexical2 {
806   my $x = 23;
807   my sub bar;
808   sub not_lexical3 {
809     not_lexical2();
810     sub bar { $x }
811   };
812   bar
813 }
814 is not_lexical3, 23, 'my subs inside predeclared package subs';
815
816 # Test my subs inside predeclared package sub, where the lexical sub is
817 # declared outside the package sub.
818 # This checks that CvOUTSIDE pointers are fixed up even when the sub is
819 # not declared inside the sub that its CvOUTSIDE points to.
820 sub not_lexical5 {
821   my sub foo;
822   sub not_lexical4;
823   sub not_lexical4 {
824     my $x = 234;
825     not_lexical5();
826     sub foo { $x }
827   }
828   foo
829 }
830 is not_lexical4, 234,
831     'my sub defined in predeclared pkg sub but declared outside';
832
833 undef *not_lexical6;
834 {
835   my sub foo;
836   sub not_lexical6 { sub foo { } }
837   pass 'no crash when cloning a mysub declared inside an undef pack sub';
838 }
839
840 undef &not_lexical7;
841 eval 'sub not_lexical7 { my @x }';
842 {
843   my sub foo;
844   foo();
845   sub not_lexical7 {
846     state $x;
847     sub foo {
848       is ref \$x, 'SCALAR',
849         "redeffing a mysub's outside does not make it use the wrong pad"
850     }
851   }
852 }
853
854 like runperl(
855       switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
856       prog     => 'my sub foo; sub foo { foo } foo',
857       stderr   => 1
858      ),
859      qr/Deep recursion on subroutine "foo"/,
860     'deep recursion warnings for lexical subs do not crash';
861
862 like runperl(
863       switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
864       prog     => 'my sub foo() { 42 } undef &foo',
865       stderr   => 1
866      ),
867      qr/Constant subroutine foo undefined at /,
868     'constant undefinition warnings for lexical subs do not crash';
869
870 {
871   my sub foo;
872   *AutoloadTestSuper::blah = \&foo;
873   sub AutoloadTestSuper::AUTOLOAD {
874     is $AutoloadTestSuper::AUTOLOAD, "AutoloadTestSuper::blah",
875       "Autoloading via inherited lex stub";
876   }
877   @AutoloadTest::ISA = AutoloadTestSuper::;
878   AutoloadTest->blah;
879 }