This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op.c:newMYSUB: Pop scope after creating sub
[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';
e07561e6 11plan 62;
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
87sub on { $::TODO = ' ' }
88sub off { $::TODO = undef }
89
90use 5.01; # state
91{
92 state sub foo { 44 }
97b03d64
FC
93 isnt \&::foo, \&foo, 'state sub is not stored in the package';
94 is eval foo, 44, 'calling state sub from same package';
95 is eval &foo, 44, 'calling state sub from same package (amper)';
96 is eval do foo(), 44, 'calling state sub from same package (do)';
21452252 97 package bar;
97b03d64
FC
98 is eval foo, 44, 'calling state sub from another package';
99 is eval &foo, 44, 'calling state sub from another package (amper)';
100 is eval do foo(), 44, 'calling state sub from another package (do)';
21452252 101}
21452252
FC
102package bar;
103is foo, 43, 'state sub falling out of scope';
104is &foo, 43, 'state sub falling out of scope (called via amper)';
105is do foo(), 43, 'state sub falling out of scope (called via amper)';
106{
107 sub sa { 43 }
108 state sub sa {
109 if (shift) {
110 is sa, 43, 'state sub invisible inside itself';
111 is &sa, 43, 'state sub invisible inside itself (called via amper)';
112 is do sa(), 43, 'state sub invisible inside itself (called via do)';
113 }
114 44
115 }
21452252 116 sa(1);
21452252
FC
117 sub sb { 43 }
118 state sub sb;
119 state sub sb {
120 if (shift) {
121 # ‘state sub foo{}’ creates a new pad entry, not reusing the forward
122 # declaration. Being invisible inside itself, it sees the stub.
123 eval{sb};
124 like $@, qr/^Undefined subroutine &sb called at /,
125 'state sub foo {} after forward declaration';
126 eval{&sb};
127 like $@, qr/^Undefined subroutine &sb called at /,
128 'state sub foo {} after forward declaration (amper)';
129 eval{do sb()};
130 like $@, qr/^Undefined subroutine &sb called at /,
131 'state sub foo {} after forward declaration (do)';
132 }
133 44
134 }
21452252 135 sb(1);
21452252
FC
136 sub sb2 { 43 }
137 state sub sb2;
138 sub sb2 {
139 if (shift) {
140 package bar;
97b03d64
FC
141 is sb2, 44, 'state sub visible inside itself after decl';
142 is &sb2, 44, 'state sub visible inside itself after decl (amper)';
143 is do sb2(), 44, 'state sub visible inside itself after decl (do)';
21452252
FC
144 }
145 44
146 }
21452252 147 sb2(1);
21452252
FC
148 state sub sb3;
149 {
150 state sub sb3 { # new pad entry
151 # The sub containing this comment is invisible inside itself.
152 # So this one here will assign to the outer pad entry:
153 sub sb3 { 47 }
154 }
155 }
21452252
FC
156 is eval{sb3}, 47,
157 'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
158}
159sub sc { 43 }
160{
161 state sub sc;
162 eval{sc};
251a11d5 163 like $@, qr/^Undefined subroutine &sc called at /,
21452252
FC
164 'state sub foo; makes no lex alias for existing sub';
165 eval{&sc};
251a11d5 166 like $@, qr/^Undefined subroutine &sc called at /,
21452252
FC
167 'state sub foo; makes no lex alias for existing sub (amper)';
168 eval{do sc()};
251a11d5 169 like $@, qr/^Undefined subroutine &sc called at /,
21452252
FC
170 'state sub foo; makes no lex alias for existing sub (do)';
171}
172package main;
173{
174 state sub se ($);
175 is prototype eval{\&se}, '$', 'state sub with proto';
21452252
FC
176 is prototype "se", undef, 'prototype "..." ignores state subs';
177}
178{
179 state sub if() { 44 }
180 my $x = if if if;
181 is $x, 44, 'state subs override all keywords';
182 package bar;
183 my $y = if if if;
184 is $y, 44, 'state subs from other packages override all keywords';
185}
186{
187 use warnings;
188 state $w ;
189 local $SIG{__WARN__} = sub { $w .= shift };
190 eval '#line 87 squidges
191 state sub foo;
192 state sub foo {};
193 ';
21452252 194 is $w,
4eb94d7c 195 '"state" subroutine &foo masks earlier declaration in same scope at '
21452252 196 . "squidges line 88.\n",
4eb94d7c 197 'warning for state sub masking earlier declaration';
21452252
FC
198}
199# Since state vars inside anonymous subs are cloned at the same time as the
200# anonymous subs containing them, the same should happen for state subs.
201sub make_closure {
e07561e6 202 my $x = shift;
21452252
FC
203 sub {
204 state sub foo { $x }
e07561e6 205 foo
21452252
FC
206 }
207}
208$sub1 = make_closure 48;
209$sub2 = make_closure 49;
210is &$sub1, 48, 'state sub in closure (1)';
97b03d64 211is &$sub2, 49, 'state sub in closure (2)';
21452252
FC
212# But we need to test that state subs actually do persist from one invoca-
213# tion of a named sub to another (i.e., that they are not my subs).
214{
215 use warnings;
216 state $w;
217 local $SIG{__WARN__} = sub { $w .= shift };
218 eval '#line 65 teetet
219 sub foom {
220 my $x = shift;
221 state sub poom { $x }
222 eval{\&poom}
223 }
224 ';
225 is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
226 'state subs get "Variable will not stay shared" messages';
227 my $poom = foom(27);
228 my $poom2 = foom(678);
229 is eval{$poom->()}, eval {$poom2->()},
230 'state subs close over the first outer my var, like pkg subs';
231 my $x = 43;
232 for $x (765) {
233 state sub etetetet { $x }
c8e83515 234 is eval{etetetet}, 43, 'state sub ignores for() localisation';
21452252
FC
235 }
236}
e07561e6
FC
237# And we also need to test that multiple state subs can close over each
238# other’s entries in the parent subs pad, and that cv_clone is not con-
239# fused by that.
240sub make_anon_with_state_sub{
241 sub {
242 state sub s1;
243 state sub s2 { \&s1 }
244 sub s1 { \&s2 }
245 if (@_) { return \&s1 }
246 is s1,\&s2, 'state sub in anon closure closing over sibling state sub';
247 is s2,\&s1, 'state sub in anon closure closing over sibling state sub';
248 }
249}
250{
251 my $s = make_anon_with_state_sub;
252 &$s;
253
254 # And make sure the state subs were actually cloned.
255 isnt make_anon_with_state_sub->(0), &$s(0),
256 'state subs in anon subs are cloned';
257 is &$s(0), &$s(0), 'but only when the anon sub is cloned';
258}
21452252
FC
259{
260 state sub BEGIN { exit };
261 pass 'state subs are never special blocks';
262 state sub END { shift }
21452252
FC
263 is eval{END('jkqeudth')}, jkqeudth,
264 'state sub END {shift} implies @_, not @ARGV';
265}
266{
267 state sub redef {}
268 use warnings;
269 state $w;
270 local $SIG{__WARN__} = sub { $w .= shift };
271 eval "#line 56 pygpyf\nsub redef {}";
272 is $w, "Subroutine redef redefined at pygpyf line 56.\n",
273 "sub redefinition warnings from state subs";
274}