This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perly.y: Remove MYSUB
[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';
6d5c2147 11plan 107;
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}
194774c2
FC
283
284# -------------------- my -------------------- #
285
286{
287 my sub foo { 44 }
288 isnt \&::foo, \&foo, 'my sub is not stored in the package';
289 is foo, 44, 'calling my sub from same package';
290 is &foo, 44, 'calling my sub from same package (amper)';
291 is do foo(), 44, 'calling my sub from same package (do)';
292 package bar;
293 is foo, 44, 'calling my sub from another package';
294 is &foo, 44, 'calling my sub from another package (amper)';
295 is do foo(), 44, 'calling my sub from another package (do)';
296}
297package bar;
298is foo, 43, 'my sub falling out of scope';
299is &foo, 43, 'my sub falling out of scope (called via amper)';
300is do foo(), 43, 'my sub falling out of scope (called via amper)';
301{
302 sub ma { 43 }
303 my sub ma {
304 if (shift) {
305 is ma, 43, 'my sub invisible inside itself';
306 is &ma, 43, 'my sub invisible inside itself (called via amper)';
307 is do ma(), 43, 'my sub invisible inside itself (called via do)';
308 }
309 44
310 }
311 ma(1);
312 sub mb { 43 }
313 my sub mb;
314 my sub mb {
315 if (shift) {
316 # ‘my sub foo{}’ creates a new pad entry, not reusing the forward
317 # declaration. Being invisible inside itself, it sees the stub.
318 eval{mb};
319 like $@, qr/^Undefined subroutine &mb called at /,
320 'my sub foo {} after forward declaration';
321 eval{&mb};
322 like $@, qr/^Undefined subroutine &mb called at /,
323 'my sub foo {} after forward declaration (amper)';
324 eval{do mb()};
325 like $@, qr/^Undefined subroutine &mb called at /,
326 'my sub foo {} after forward declaration (do)';
327 }
328 44
329 }
330 mb(1);
331 sub mb2 { 43 }
332 my sub sb2;
333 sub mb2 {
334 if (shift) {
335 package bar;
336 is mb2, 44, 'my sub visible inside itself after decl';
337 is &mb2, 44, 'my sub visible inside itself after decl (amper)';
338 is do mb2(), 44, 'my sub visible inside itself after decl (do)';
339 }
340 44
341 }
342 mb2(1);
343 my sub mb3;
344 {
345 my sub mb3 { # new pad entry
346 # The sub containing this comment is invisible inside itself.
347 # So this one here will assign to the outer pad entry:
348 sub mb3 { 47 }
349 }
350 }
351 is eval{mb3}, 47,
352 'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
10342479
FC
353 # Same test again, but inside an anonymous sub
354 sub {
355 my sub mb4;
356 {
357 my sub mb4 {
358 sub mb4 { 47 }
359 }
360 }
361 is mb4, 47,
362 'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
363 }->();
194774c2
FC
364}
365sub mc { 43 }
366{
367 my sub mc;
368 eval{mc};
369 like $@, qr/^Undefined subroutine &mc called at /,
370 'my sub foo; makes no lex alias for existing sub';
371 eval{&mc};
372 like $@, qr/^Undefined subroutine &mc called at /,
373 'my sub foo; makes no lex alias for existing sub (amper)';
374 eval{do mc()};
375 like $@, qr/^Undefined subroutine &mc called at /,
376 'my sub foo; makes no lex alias for existing sub (do)';
377}
378package main;
379{
380 my sub me ($);
381 is prototype eval{\&me}, '$', 'my sub with proto';
382 is prototype "me", undef, 'prototype "..." ignores my subs';
383}
384{
385 my sub if() { 44 }
386 my $x = if if if;
387 is $x, 44, 'my subs override all keywords';
388 package bar;
389 my $y = if if if;
390 is $y, 44, 'my subs from other packages override all keywords';
391}
392{
393 use warnings;
394 my $w ;
395 local $SIG{__WARN__} = sub { $w .= shift };
396 eval '#line 87 squidges
397 my sub foo;
398 my sub foo {};
399 ';
400 is $w,
401 '"my" subroutine &foo masks earlier declaration in same scope at '
402 . "squidges line 88.\n",
403 'warning for my sub masking earlier declaration';
404}
405# Test that my subs are cloned inside anonymous subs.
406sub mmake_closure {
407 my $x = shift;
408 sub {
409 my sub foo { $x }
410 foo
411 }
412}
413$sub1 = mmake_closure 48;
414$sub2 = mmake_closure 49;
6d5c2147
FC
415is &$sub1, 48, 'my sub in closure (1)';
416is &$sub2, 49, 'my sub in closure (2)';
194774c2
FC
417# Test that they are cloned in named subs.
418{
419 use warnings;
420 my $w;
421 local $SIG{__WARN__} = sub { $w .= shift };
422 eval '#line 65 teetet
6d5c2147 423 sub mfoom {
194774c2
FC
424 my $x = shift;
425 my sub poom { $x }
6d5c2147 426 \&poom
194774c2
FC
427 }
428 ';
429 is $w, undef, 'my subs get no "Variable will not stay shared" messages';
6d5c2147
FC
430 my $poom = mfoom(27);
431 my $poom2 = mfoom(678);
432 is $poom->(), 27, 'my subs closing over outer my var (1)';
433 is $poom2->(), 678, 'my subs closing over outer my var (2)';
194774c2
FC
434 my $x = 43;
435 my sub aoeu;
436 for $x (765) {
437 my sub etetetet { $x }
6d5c2147 438 sub aoeu { $x }
194774c2 439 is etetetet, 765, 'my sub respects for() localisation';
194774c2
FC
440 is aoeu, 43, 'unless it is declared outside the for loop';
441 }
442}
443# And we also need to test that multiple my subs can close over each
444# other’s entries in the parent subs pad, and that cv_clone is not con-
445# fused by that.
446sub make_anon_with_my_sub{
447 sub {
448 my sub s1;
449 my sub s2 { \&s1 }
450 sub s1 { \&s2 }
451 if (@_) { return eval { \&s1 } }
452 is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub';
453 is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub';
454 }
455}
456{
457 my $s = make_anon_with_my_sub;
458 &$s;
459
460 # And make sure the my subs were actually cloned.
194774c2
FC
461 isnt make_anon_with_my_sub->(0), &$s(0),
462 'my subs in anon subs are cloned';
463 isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub';
194774c2
FC
464}
465{
466 my sub BEGIN { exit };
467 pass 'my subs are never special blocks';
468 my sub END { shift }
469 is END('jkqeudth'), jkqeudth,
470 'my sub END {shift} implies @_, not @ARGV';
471}
472{
473 my sub redef {}
474 use warnings;
475 my $w;
476 local $SIG{__WARN__} = sub { $w .= shift };
477 eval "#line 56 pygpyf\nsub redef {}";
478 is $w, "Subroutine redef redefined at pygpyf line 56.\n",
479 "sub redefinition warnings from my subs";
480}
6d5c2147
FC
481
482# -------------------- Interactions (and misc tests) -------------------- #
483
484is sub {
485 my sub s1;
486 my sub s2 { 3 };
487 sub s1 { state sub foo { \&s2 } foo }
488 s1
489 }->()(), 3, 'state sub inside my sub closing over my sub uncle';
490