This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Honour lexical prototypes
[perl5.git] / t / cmd / lexsub.t
CommitLineData
c07656ed
FC
1#!perl
2
39075fb1
FC
3BEGIN {
4 chdir 't';
4b473a5a 5 @INC = '../lib';
39075fb1
FC
6 require './test.pl';
7 *bar::is = *is;
21452252 8 *bar::like = *like;
39075fb1 9}
4b473a5a 10no warnings 'deprecated';
279d09bf 11plan 121;
21452252
FC
12
13# -------------------- our -------------------- #
c07656ed
FC
14
15{
16 our sub foo { 42 }
39075fb1
FC
17 is foo, 42, 'calling our sub from same package';
18 is &foo, 42, 'calling our sub from same package (amper)';
4b473a5a 19 is do foo(), 42, 'calling our sub from same package (do)';
c07656ed
FC
20 package bar;
21 sub bar::foo { 43 }
18f70389 22 is foo, 42, 'calling our sub from another package';
39075fb1 23 is &foo, 42, 'calling our sub from another package (amper)';
4b473a5a 24 is do foo(), 42, 'calling our sub from another package (do)';
c07656ed
FC
25}
26package bar;
39075fb1
FC
27is foo, 43, 'our sub falling out of scope';
28is &foo, 43, 'our sub falling out of scope (called via amper)';
4b473a5a 29is do foo(), 43, 'our sub falling out of scope (called via amper)';
c07656ed
FC
30package main;
31{
32 sub bar::a { 43 }
33 our sub a {
34 if (shift) {
35 package bar;
39075fb1
FC
36 is a, 43, 'our sub invisible inside itself';
37 is &a, 43, 'our sub invisible inside itself (called via amper)';
4b473a5a 38 is do a(), 43, 'our sub invisible inside itself (called via do)';
c07656ed
FC
39 }
40 42
41 }
42 a(1);
43 sub bar::b { 43 }
44 our sub b;
45 our sub b {
46 if (shift) {
47 package bar;
18f70389 48 is b, 42, 'our sub visible inside itself after decl';
39075fb1 49 is &b, 42, 'our sub visible inside itself after decl (amper)';
4b473a5a 50 is do b(), 42, 'our sub visible inside itself after decl (do)';
c07656ed
FC
51 }
52 42
53 }
54 b(1)
55}
56sub c { 42 }
57sub bar::c { 43 }
58{
59 our sub c;
60 package bar;
18f70389 61 is c, 42, 'our sub foo; makes lex alias for existing sub';
39075fb1 62 is &c, 42, 'our sub foo; makes lex alias for existing sub (amper)';
4b473a5a 63 is do c(), 42, 'our sub foo; makes lex alias for existing sub (do)';
c07656ed
FC
64}
65{
66 our sub d;
c07656ed
FC
67 sub bar::d { 'd43' }
68 package bar;
945534e1 69 sub d { 'd42' }
4210d3f1 70 is eval ::d, 'd42', 'our sub foo; applies to subsequent sub foo {}';
c07656ed 71}
60ac52eb
FC
72{
73 our sub e ($);
74 is prototype "::e", '$', 'our sub with proto';
75}
18f70389 76{
18f70389
FC
77 our sub if() { 42 }
78 my $x = if if if;
f37b842a
FC
79 is $x, 42, 'lexical subs (even our) override all keywords';
80 package bar;
81 my $y = if if if;
82 is $y, 42, 'our subs from other packages override all keywords';
18f70389 83}
21452252
FC
84
85# -------------------- state -------------------- #
86
21452252
FC
87use 5.01; # state
88{
89 state sub foo { 44 }
97b03d64
FC
90 isnt \&::foo, \&foo, 'state sub is not stored in the package';
91 is eval foo, 44, 'calling state sub from same package';
92 is eval &foo, 44, 'calling state sub from same package (amper)';
93 is eval do foo(), 44, 'calling state sub from same package (do)';
21452252 94 package bar;
97b03d64
FC
95 is eval foo, 44, 'calling state sub from another package';
96 is eval &foo, 44, 'calling state sub from another package (amper)';
97 is eval do foo(), 44, 'calling state sub from another package (do)';
21452252 98}
21452252
FC
99package bar;
100is foo, 43, 'state sub falling out of scope';
101is &foo, 43, 'state sub falling out of scope (called via amper)';
102is do foo(), 43, 'state sub falling out of scope (called via amper)';
103{
104 sub sa { 43 }
105 state sub sa {
106 if (shift) {
107 is sa, 43, 'state sub invisible inside itself';
108 is &sa, 43, 'state sub invisible inside itself (called via amper)';
109 is do sa(), 43, 'state sub invisible inside itself (called via do)';
110 }
111 44
112 }
21452252 113 sa(1);
21452252
FC
114 sub sb { 43 }
115 state sub sb;
116 state sub sb {
117 if (shift) {
118 # ‘state sub foo{}’ creates a new pad entry, not reusing the forward
119 # declaration. Being invisible inside itself, it sees the stub.
120 eval{sb};
121 like $@, qr/^Undefined subroutine &sb called at /,
122 'state sub foo {} after forward declaration';
123 eval{&sb};
124 like $@, qr/^Undefined subroutine &sb called at /,
125 'state sub foo {} after forward declaration (amper)';
126 eval{do sb()};
127 like $@, qr/^Undefined subroutine &sb called at /,
128 'state sub foo {} after forward declaration (do)';
129 }
130 44
131 }
21452252 132 sb(1);
21452252
FC
133 sub sb2 { 43 }
134 state sub sb2;
135 sub sb2 {
136 if (shift) {
137 package bar;
97b03d64
FC
138 is sb2, 44, 'state sub visible inside itself after decl';
139 is &sb2, 44, 'state sub visible inside itself after decl (amper)';
140 is do sb2(), 44, 'state sub visible inside itself after decl (do)';
21452252
FC
141 }
142 44
143 }
21452252 144 sb2(1);
21452252
FC
145 state sub sb3;
146 {
147 state sub sb3 { # new pad entry
148 # The sub containing this comment is invisible inside itself.
149 # So this one here will assign to the outer pad entry:
150 sub sb3 { 47 }
151 }
152 }
21452252
FC
153 is eval{sb3}, 47,
154 'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
10342479
FC
155 # Same test again, but inside an anonymous sub
156 sub {
157 state sub sb4;
158 {
159 state sub sb4 {
160 sub sb4 { 47 }
161 }
162 }
163 is sb4, 47,
164 'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
165 }->();
21452252
FC
166}
167sub sc { 43 }
168{
169 state sub sc;
170 eval{sc};
251a11d5 171 like $@, qr/^Undefined subroutine &sc called at /,
21452252
FC
172 'state sub foo; makes no lex alias for existing sub';
173 eval{&sc};
251a11d5 174 like $@, qr/^Undefined subroutine &sc called at /,
21452252
FC
175 'state sub foo; makes no lex alias for existing sub (amper)';
176 eval{do sc()};
251a11d5 177 like $@, qr/^Undefined subroutine &sc called at /,
21452252
FC
178 'state sub foo; makes no lex alias for existing sub (do)';
179}
180package main;
181{
182 state sub se ($);
183 is prototype eval{\&se}, '$', 'state sub with proto';
21452252
FC
184 is prototype "se", undef, 'prototype "..." ignores state subs';
185}
186{
187 state sub if() { 44 }
188 my $x = if if if;
189 is $x, 44, 'state subs override all keywords';
190 package bar;
191 my $y = if if if;
192 is $y, 44, 'state subs from other packages override all keywords';
193}
194{
195 use warnings;
196 state $w ;
197 local $SIG{__WARN__} = sub { $w .= shift };
198 eval '#line 87 squidges
199 state sub foo;
200 state sub foo {};
201 ';
21452252 202 is $w,
4eb94d7c 203 '"state" subroutine &foo masks earlier declaration in same scope at '
21452252 204 . "squidges line 88.\n",
4eb94d7c 205 'warning for state sub masking earlier declaration';
21452252
FC
206}
207# Since state vars inside anonymous subs are cloned at the same time as the
208# anonymous subs containing them, the same should happen for state subs.
209sub make_closure {
e07561e6 210 my $x = shift;
21452252
FC
211 sub {
212 state sub foo { $x }
e07561e6 213 foo
21452252
FC
214 }
215}
216$sub1 = make_closure 48;
217$sub2 = make_closure 49;
218is &$sub1, 48, 'state sub in closure (1)';
97b03d64 219is &$sub2, 49, 'state sub in closure (2)';
21452252
FC
220# But we need to test that state subs actually do persist from one invoca-
221# tion of a named sub to another (i.e., that they are not my subs).
222{
223 use warnings;
224 state $w;
225 local $SIG{__WARN__} = sub { $w .= shift };
226 eval '#line 65 teetet
227 sub foom {
228 my $x = shift;
229 state sub poom { $x }
230 eval{\&poom}
231 }
232 ';
233 is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
234 'state subs get "Variable will not stay shared" messages';
235 my $poom = foom(27);
236 my $poom2 = foom(678);
237 is eval{$poom->()}, eval {$poom2->()},
238 'state subs close over the first outer my var, like pkg subs';
239 my $x = 43;
240 for $x (765) {
241 state sub etetetet { $x }
c8e83515 242 is eval{etetetet}, 43, 'state sub ignores for() localisation';
21452252
FC
243 }
244}
e07561e6
FC
245# And we also need to test that multiple state subs can close over each
246# other’s entries in the parent subs pad, and that cv_clone is not con-
247# fused by that.
248sub make_anon_with_state_sub{
249 sub {
250 state sub s1;
251 state sub s2 { \&s1 }
252 sub s1 { \&s2 }
253 if (@_) { return \&s1 }
254 is s1,\&s2, 'state sub in anon closure closing over sibling state sub';
255 is s2,\&s1, 'state sub in anon closure closing over sibling state sub';
256 }
257}
258{
259 my $s = make_anon_with_state_sub;
260 &$s;
261
262 # And make sure the state subs were actually cloned.
263 isnt make_anon_with_state_sub->(0), &$s(0),
264 'state subs in anon subs are cloned';
265 is &$s(0), &$s(0), 'but only when the anon sub is cloned';
266}
21452252
FC
267{
268 state sub BEGIN { exit };
269 pass 'state subs are never special blocks';
270 state sub END { shift }
21452252
FC
271 is eval{END('jkqeudth')}, jkqeudth,
272 'state sub END {shift} implies @_, not @ARGV';
273}
274{
275 state sub redef {}
276 use warnings;
277 state $w;
278 local $SIG{__WARN__} = sub { $w .= shift };
279 eval "#line 56 pygpyf\nsub redef {}";
280 is $w, "Subroutine redef redefined at pygpyf line 56.\n",
281 "sub redefinition warnings from state subs";
282}
279d09bf
FC
283{
284 state sub p (\@) {
285 is ref $_[0], 'ARRAY', 'state sub with proto';
286 }
287 p(my @a);
288}
194774c2
FC
289
290# -------------------- my -------------------- #
291
292{
293 my sub foo { 44 }
294 isnt \&::foo, \&foo, 'my sub is not stored in the package';
295 is foo, 44, 'calling my sub from same package';
296 is &foo, 44, 'calling my sub from same package (amper)';
297 is do foo(), 44, 'calling my sub from same package (do)';
298 package bar;
299 is foo, 44, 'calling my sub from another package';
300 is &foo, 44, 'calling my sub from another package (amper)';
301 is do foo(), 44, 'calling my sub from another package (do)';
302}
303package bar;
304is foo, 43, 'my sub falling out of scope';
305is &foo, 43, 'my sub falling out of scope (called via amper)';
306is do foo(), 43, 'my sub falling out of scope (called via amper)';
307{
308 sub ma { 43 }
309 my sub ma {
310 if (shift) {
311 is ma, 43, 'my sub invisible inside itself';
312 is &ma, 43, 'my sub invisible inside itself (called via amper)';
313 is do ma(), 43, 'my sub invisible inside itself (called via do)';
314 }
315 44
316 }
317 ma(1);
318 sub mb { 43 }
319 my sub mb;
320 my sub mb {
321 if (shift) {
322 # ‘my sub foo{}’ creates a new pad entry, not reusing the forward
323 # declaration. Being invisible inside itself, it sees the stub.
324 eval{mb};
325 like $@, qr/^Undefined subroutine &mb called at /,
326 'my sub foo {} after forward declaration';
327 eval{&mb};
328 like $@, qr/^Undefined subroutine &mb called at /,
329 'my sub foo {} after forward declaration (amper)';
330 eval{do mb()};
331 like $@, qr/^Undefined subroutine &mb called at /,
332 'my sub foo {} after forward declaration (do)';
333 }
334 44
335 }
336 mb(1);
337 sub mb2 { 43 }
338 my sub sb2;
339 sub mb2 {
340 if (shift) {
341 package bar;
342 is mb2, 44, 'my sub visible inside itself after decl';
343 is &mb2, 44, 'my sub visible inside itself after decl (amper)';
344 is do mb2(), 44, 'my sub visible inside itself after decl (do)';
345 }
346 44
347 }
348 mb2(1);
349 my sub mb3;
350 {
351 my sub mb3 { # new pad entry
352 # The sub containing this comment is invisible inside itself.
353 # So this one here will assign to the outer pad entry:
354 sub mb3 { 47 }
355 }
356 }
357 is eval{mb3}, 47,
358 'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
10342479
FC
359 # Same test again, but inside an anonymous sub
360 sub {
361 my sub mb4;
362 {
363 my sub mb4 {
364 sub mb4 { 47 }
365 }
366 }
367 is mb4, 47,
368 'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
369 }->();
194774c2
FC
370}
371sub mc { 43 }
372{
373 my sub mc;
374 eval{mc};
375 like $@, qr/^Undefined subroutine &mc called at /,
376 'my sub foo; makes no lex alias for existing sub';
377 eval{&mc};
378 like $@, qr/^Undefined subroutine &mc called at /,
379 'my sub foo; makes no lex alias for existing sub (amper)';
380 eval{do mc()};
381 like $@, qr/^Undefined subroutine &mc called at /,
382 'my sub foo; makes no lex alias for existing sub (do)';
383}
384package main;
385{
386 my sub me ($);
387 is prototype eval{\&me}, '$', 'my sub with proto';
388 is prototype "me", undef, 'prototype "..." ignores my subs';
389}
390{
391 my sub if() { 44 }
392 my $x = if if if;
393 is $x, 44, 'my subs override all keywords';
394 package bar;
395 my $y = if if if;
396 is $y, 44, 'my subs from other packages override all keywords';
397}
398{
399 use warnings;
400 my $w ;
401 local $SIG{__WARN__} = sub { $w .= shift };
402 eval '#line 87 squidges
403 my sub foo;
404 my sub foo {};
405 ';
406 is $w,
407 '"my" subroutine &foo masks earlier declaration in same scope at '
408 . "squidges line 88.\n",
409 'warning for my sub masking earlier declaration';
410}
411# Test that my subs are cloned inside anonymous subs.
412sub mmake_closure {
413 my $x = shift;
414 sub {
415 my sub foo { $x }
416 foo
417 }
418}
419$sub1 = mmake_closure 48;
420$sub2 = mmake_closure 49;
6d5c2147
FC
421is &$sub1, 48, 'my sub in closure (1)';
422is &$sub2, 49, 'my sub in closure (2)';
194774c2
FC
423# Test that they are cloned in named subs.
424{
425 use warnings;
426 my $w;
427 local $SIG{__WARN__} = sub { $w .= shift };
428 eval '#line 65 teetet
6d5c2147 429 sub mfoom {
194774c2
FC
430 my $x = shift;
431 my sub poom { $x }
6d5c2147 432 \&poom
194774c2
FC
433 }
434 ';
435 is $w, undef, 'my subs get no "Variable will not stay shared" messages';
6d5c2147
FC
436 my $poom = mfoom(27);
437 my $poom2 = mfoom(678);
438 is $poom->(), 27, 'my subs closing over outer my var (1)';
439 is $poom2->(), 678, 'my subs closing over outer my var (2)';
194774c2
FC
440 my $x = 43;
441 my sub aoeu;
442 for $x (765) {
443 my sub etetetet { $x }
6d5c2147 444 sub aoeu { $x }
194774c2 445 is etetetet, 765, 'my sub respects for() localisation';
194774c2
FC
446 is aoeu, 43, 'unless it is declared outside the for loop';
447 }
448}
449# And we also need to test that multiple my subs can close over each
450# other’s entries in the parent subs pad, and that cv_clone is not con-
451# fused by that.
452sub make_anon_with_my_sub{
453 sub {
454 my sub s1;
455 my sub s2 { \&s1 }
456 sub s1 { \&s2 }
457 if (@_) { return eval { \&s1 } }
458 is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub';
459 is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub';
460 }
461}
0afba48f
FC
462
463# Test my subs inside predeclared my subs
464{
465 my sub s2;
466 sub s2 {
467 my $x = 3;
468 my sub s3 { eval '$x' }
469 s3;
470 }
0afba48f
FC
471 is s2, 3, 'my sub inside predeclared my sub';
472}
473
194774c2
FC
474{
475 my $s = make_anon_with_my_sub;
476 &$s;
477
478 # And make sure the my subs were actually cloned.
194774c2
FC
479 isnt make_anon_with_my_sub->(0), &$s(0),
480 'my subs in anon subs are cloned';
481 isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub';
194774c2
FC
482}
483{
484 my sub BEGIN { exit };
485 pass 'my subs are never special blocks';
486 my sub END { shift }
487 is END('jkqeudth'), jkqeudth,
488 'my sub END {shift} implies @_, not @ARGV';
489}
490{
491 my sub redef {}
492 use warnings;
493 my $w;
494 local $SIG{__WARN__} = sub { $w .= shift };
495 eval "#line 56 pygpyf\nsub redef {}";
496 is $w, "Subroutine redef redefined at pygpyf line 56.\n",
497 "sub redefinition warnings from my subs";
4e85e1b4
FC
498
499 undef $w;
500 sub {
501 my sub x {};
502 sub { eval "#line 87 khaki\n\\&x" }
503 }->()();
504 is $w, "Subroutine \"&x\" is not available at khaki line 87.\n",
505 "unavailability warning during compilation of eval in closure";
506
507 undef $w;
508 no warnings 'void';
509 eval <<'->()();';
510#line 87 khaki
511 sub {
512 my sub x{}
513 sub not_lexical8 {
514 \&x
515 }
516 }
517->()();
518 is $w, "Subroutine \"&x\" is not available at khaki line 90.\n",
519 "unavailability warning during compilation of named sub in anon";
cf748c3c
FC
520
521 undef $w;
522 sub not_lexical9 {
523 my sub x {};
524 format =
525@
526&x
527.
528 }
529 eval { write };
530 my($f,$l) = (__FILE__,__LINE__ - 1);
531 is $w, "Subroutine \"&x\" is not available at $f line $l.\n",
532 'unavailability warning during cloning';
533 $l -= 3;
534 is $@, "Undefined subroutine &x called at $f line $l.\n",
535 'Vivified sub is correctly named';
194774c2 536}
ebfebee4
FC
537sub not_lexical10 {
538 my sub foo;
539 foo();
540 sub not_lexical11 {
541 my sub bar {
542 my $x = 'khaki car keys for the khaki car';
543 not_lexical10();
544 sub foo {
545 is $x, 'khaki car keys for the khaki car',
546 'mysubs in inner clonables use the running clone of their CvOUTSIDE'
547 }
548 }
549 bar()
550 }
551}
552not_lexical11();
279d09bf
FC
553{
554 my sub p (\@) {
555 is ref $_[0], 'ARRAY', 'my sub with proto';
556 }
557 p(my @a);
558}
559{
560 my sub x;
561 my $count;
562 sub x { x() if $count++ < 10 }
563 x();
564 is $count, 11, 'my recursive subs';
565}
6d5c2147
FC
566
567# -------------------- Interactions (and misc tests) -------------------- #
568
569is sub {
570 my sub s1;
571 my sub s2 { 3 };
572 sub s1 { state sub foo { \&s2 } foo }
573 s1
574 }->()(), 3, 'state sub inside my sub closing over my sub uncle';
575
0afba48f
FC
576{
577 my sub s2 { 3 };
578 sub not_lexical { state sub foo { \&s2 } foo }
579 is not_lexical->(), 3, 'state subs that reference my sub from outside';
580}
581
582# Test my subs inside predeclared package subs
583# This test also checks that CvOUTSIDE pointers are not mangled when the
584# inner sub’s CvOUTSIDE points to another sub.
585sub not_lexical2;
586sub not_lexical2 {
587 my $x = 23;
588 my sub bar;
589 sub not_lexical3 {
590 not_lexical2();
591 sub bar { $x }
592 };
593 bar
594}
0afba48f
FC
595is not_lexical3, 23, 'my subs inside predeclared package subs';
596
597# Test my subs inside predeclared package sub, where the lexical sub is
598# declared outside the package sub.
599# This checks that CvOUTSIDE pointers are fixed up even when the sub is
600# not declared inside the sub that its CvOUTSIDE points to.
8d88fe29 601sub not_lexical5 {
0afba48f
FC
602 my sub foo;
603 sub not_lexical4;
604 sub not_lexical4 {
605 my $x = 234;
8d88fe29 606 not_lexical5();
0afba48f 607 sub foo { $x }
0afba48f 608 }
8d88fe29 609 foo
0afba48f 610}
8d88fe29
FC
611is not_lexical4, 234,
612 'my sub defined in predeclared pkg sub but declared outside';
1f122f9b
FC
613
614undef *not_lexical6;
615{
616 my sub foo;
617 sub not_lexical6 { sub foo { } }
618 pass 'no crash when cloning a mysub declared inside an undef pack sub';
619}
9ccc915e
FC
620
621undef &not_lexical7;
622eval 'sub not_lexical7 { my @x }';
623{
624 my sub foo;
625 foo();
626 sub not_lexical7 {
627 state $x;
628 sub foo {
629 is ref \$x, 'SCALAR',
630 "redeffing a mysub's outside does not make it use the wrong pad"
631 }
632 }
633}