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
1 #!perl
2
3 BEGIN {
4     chdir 't';
5     require './test.pl';
6     set_up_inc('../lib');
7     *bar::is = *is;
8     *bar::like = *like;
9 }
10 plan 141;
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
115 # -------------------- state -------------------- #
116
117 use feature 'state'; # state
118 {
119   state sub foo { 44 }
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)';
123   package bar;
124   is eval foo, 44, 'calling state sub from another package';
125   is eval &foo, 44, 'calling state sub from another package (amper)';
126 }
127 package bar;
128 is foo, 43, 'state sub falling out of scope';
129 is &foo, 43, 'state sub falling out of scope (called via amper)';
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)';
136     }
137     44
138   }
139   sa(1);
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)';
152     }
153     44
154   }
155   sb(1);
156   sub sb2 { 43 }
157   state sub sb2;
158   sub sb2 {
159     if (shift) {
160       package bar;
161       is sb2, 44, 'state sub visible inside itself after decl';
162       is &sb2, 44, 'state sub visible inside itself after decl (amper)';
163     }
164     44
165   }
166   sb2(1);
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   }
175   is eval{sb3}, 47,
176     'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
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   }->();
188 }
189 sub sc { 43 }
190 {
191   state sub sc;
192   eval{sc};
193   like $@, qr/^Undefined subroutine &sc called at /,
194      'state sub foo; makes no lex alias for existing sub';
195   eval{&sc};
196   like $@, qr/^Undefined subroutine &sc called at /,
197      'state sub foo; makes no lex alias for existing sub (amper)';
198 }
199 package main;
200 {
201   state sub se ($);
202   is prototype eval{\&se}, '$', 'state sub with proto';
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 {
214   use warnings; no warnings "experimental::lexical_subs";
215   state $w ;
216   local $SIG{__WARN__} = sub { $w .= shift };
217   eval '#line 87 squidges
218     state sub foo;
219     state sub foo {};
220   ';
221   is $w,
222      '"state" subroutine &foo masks earlier declaration in same scope at '
223    . "squidges line 88.\n",
224      'warning for state sub masking earlier declaration';
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.
228 sub make_closure {
229   my $x = shift;
230   sub {
231     state sub foo { $x }
232     foo
233   }
234 }
235 $sub1 = make_closure 48;
236 $sub2 = make_closure 49;
237 is &$sub1, 48, 'state sub in closure (1)';
238 is &$sub2, 49, 'state sub in closure (2)';
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 {
242   use warnings; no warnings "experimental::lexical_subs";
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 }
261     is eval{etetetet}, 43, 'state sub ignores for() localisation';
262   }
263 }
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.
267 sub 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 }
286 {
287   state sub BEGIN { exit };
288   pass 'state subs are never special blocks';
289   state sub END { shift }
290   is eval{END('jkqeudth')}, jkqeudth,
291     'state sub END {shift} implies @_, not @ARGV';
292   state sub CORE { scalar reverse shift }
293   is CORE::uc("hello"), "HELLO",
294     'lexical CORE does not interfere with CORE::...';
295 }
296 {
297   state sub redef {}
298   use warnings; no warnings "experimental::lexical_subs";
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 }
305 {
306   state sub p (\@) {
307     is ref $_[0], 'ARRAY', 'state sub with proto';
308   }
309   p(my @a);
310   p my @b;
311   state sub q () { 45 }
312   is q(), 45, 'state constant called with parens';
313 }
314 {
315   state sub x;
316   eval 'sub x {3}';
317   is x, 3, 'state sub defined inside eval';
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);
331 }
332 like runperl(
333       switches => [ '-Mfeature=lexical_subs,state' ],
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';
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 }
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 }
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 }
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 }
379 # This used to fail an assertion, but only as a standalone script
380 is runperl(switches => ['-lXMfeature=:all'],
381            prog     => 'state sub x {}; undef &x; print defined &x',
382            stderr   => 1), "\n", 'undefining state sub';
383 {
384   state sub x { is +(caller 0)[3], 'x', 'state sub name in caller' }
385   x
386 }
387 sub _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 }
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 }
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)';
408   package bar;
409   is foo, 44, 'calling my sub from another package';
410   is &foo, 44, 'calling my sub from another package (amper)';
411 }
412 package bar;
413 is foo, 43, 'my sub falling out of scope';
414 is &foo, 43, 'my sub falling out of scope (called via amper)';
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)';
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)';
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)';
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{}';
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   }->();
473 }
474 sub 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)';
483 }
484 package main;
485 {
486   my sub me ($);
487   is prototype eval{\&me}, '$', 'my sub with proto';
488   is prototype "me", undef, 'prototype "..." ignores my subs';
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");
493   is($proto, "\$\x{30cd}", "check the prototypes actually match");
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 {
504   use warnings; no warnings "experimental::lexical_subs";
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.
517 sub 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;
526 is &$sub1, 48, 'my sub in closure (1)';
527 is &$sub2, 49, 'my sub in closure (2)';
528 # Test that they are cloned in named subs.
529 {
530   use warnings; no warnings "experimental::lexical_subs";
531   my $w;
532   local $SIG{__WARN__} = sub { $w .= shift };
533   eval '#line 65 teetet
534     sub mfoom {
535       my $x = shift;
536       my sub poom { $x }
537       \&poom
538     }
539   ';
540   is $w, undef, 'my subs get no "Variable will not stay shared" messages';
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)';
545   my $x = 43;
546   my sub aoeu;
547   for $x (765) {
548     my sub etetetet { $x }
549     sub aoeu { $x }
550     is etetetet, 765, 'my sub respects for() localisation';
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.
557 sub 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 }
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   }
576   is s2, 3, 'my sub inside predeclared my sub';
577 }
578
579 {
580   my $s = make_anon_with_my_sub;
581   &$s;
582
583   # And make sure the my subs were actually cloned.
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';
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 {}
597   use warnings; no warnings "experimental::lexical_subs";
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";
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";
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';
641 }
642 sub 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 }
657 not_lexical11();
658 {
659   my sub p (\@) {
660     is ref $_[0], 'ARRAY', 'my sub with proto';
661   }
662   p(my @a);
663   p @a;
664   my sub q () { 46 }
665   is q(), 46, 'my constant called with parens';
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 }
674 {
675   my sub x;
676   eval 'sub x {3}';
677   is x, 3, 'my sub defined inside eval';
678 }
679
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 }
686 like runperl(
687       switches => [ '-Mfeature=lexical_subs,state' ],
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';
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 }
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 }
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.
722 pass "pad taking ownership once more of packagified my-sub";
723
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 }
743 # This used to fail an assertion, but only as a standalone script
744 is runperl(switches => ['-lXMfeature=:all'],
745            prog     => 'my sub x {}; undef &x; print defined &x',
746            stderr   => 1), "\n", 'undefining my sub';
747 {
748   my sub x { is +(caller 0)[3], 'x', 'my sub name in caller' }
749   x
750 }
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 }
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 }
762
763 # -------------------- Interactions (and misc tests) -------------------- #
764
765 is 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
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.
781 sub not_lexical2;
782 sub 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 }
791 is 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.
797 sub not_lexical5 {
798   my sub foo;
799   sub not_lexical4;
800   sub not_lexical4 {
801     my $x = 234;
802     not_lexical5();
803     sub foo { $x }
804   }
805   foo
806 }
807 is not_lexical4, 234,
808     'my sub defined in predeclared pkg sub but declared outside';
809
810 undef *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 }
816
817 undef &not_lexical7;
818 eval '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 }
830
831 like runperl(
832       switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
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';
838
839 like runperl(
840       switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
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';
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 }