This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make pad_fixup_inner_anons cope with closed-over subs
[perl5.git] / t / cmd / lexsub.t
1 #!perl
2
3 BEGIN {
4     chdir 't';
5     @INC = '../lib';
6     require './test.pl';
7     *bar::is = *is;
8     *bar::like = *like;
9 }
10 no warnings 'deprecated';
11 plan 58;
12
13 # -------------------- our -------------------- #
14
15 {
16   our sub foo { 42 }
17   is foo, 42, 'calling our sub from same package';
18   is &foo, 42, 'calling our sub from same package (amper)';
19   is do foo(), 42, 'calling our sub from same package (do)';
20   package bar;
21   sub bar::foo { 43 }
22   is foo, 42, 'calling our sub from another package';
23   is &foo, 42, 'calling our sub from another package (amper)';
24   is do foo(), 42, 'calling our sub from another package (do)';
25 }
26 package bar;
27 is foo, 43, 'our sub falling out of scope';
28 is &foo, 43, 'our sub falling out of scope (called via amper)';
29 is do foo(), 43, 'our sub falling out of scope (called via amper)';
30 package main;
31 {
32   sub bar::a { 43 }
33   our sub a {
34     if (shift) {
35       package bar;
36       is a, 43, 'our sub invisible inside itself';
37       is &a, 43, 'our sub invisible inside itself (called via amper)';
38       is do a(), 43, 'our sub invisible inside itself (called via do)';
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;
48       is b, 42, 'our sub visible inside itself after decl';
49       is &b, 42, 'our sub visible inside itself after decl (amper)';
50       is do b(), 42, 'our sub visible inside itself after decl (do)';
51     }
52     42
53   }
54   b(1)
55 }
56 sub c { 42 }
57 sub bar::c { 43 }
58 {
59   our sub c;
60   package bar;
61   is c, 42, 'our sub foo; makes lex alias for existing sub';
62   is &c, 42, 'our sub foo; makes lex alias for existing sub (amper)';
63   is do c(), 42, 'our sub foo; makes lex alias for existing sub (do)';
64 }
65 {
66   our sub d;
67   sub bar::d { 'd43' }
68   package bar;
69   sub d { 'd42' }
70   is eval ::d, 'd42', 'our sub foo; applies to subsequent sub foo {}';
71 }
72 {
73   our sub e ($);
74   is prototype "::e", '$', 'our sub with proto';
75 }
76 {
77   our sub if() { 42 }
78   my $x = if if if;
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';
83 }
84
85 # -------------------- state -------------------- #
86
87 sub on { $::TODO = ' ' }
88 sub off { $::TODO = undef }
89
90 use 5.01; # state
91 {
92   state sub foo { 44 }
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)';
97   package bar;
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)';
101 }
102 package bar;
103 is foo, 43, 'state sub falling out of scope';
104 is &foo, 43, 'state sub falling out of scope (called via amper)';
105 is 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   }
116   sa(1);
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   }
135   sb(1);
136   sub sb2 { 43 }
137   state sub sb2;
138   sub sb2 {
139     if (shift) {
140       package bar;
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)';
144     }
145     44
146   }
147   sb2(1);
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   }
156   is eval{sb3}, 47,
157     'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
158 }
159 sub sc { 43 }
160 {
161   state sub sc;
162   eval{sc};
163 ::on;
164   like $@, qr/^Undefined subroutine &sb called at /,
165      'state sub foo; makes no lex alias for existing sub';
166   eval{&sc};
167   like $@, qr/^Undefined subroutine &sb called at /,
168      'state sub foo; makes no lex alias for existing sub (amper)';
169   eval{do sc()};
170   like $@, qr/^Undefined subroutine &sb called at /,
171      'state sub foo; makes no lex alias for existing sub (do)';
172 ::off;
173 }
174 package main;
175 {
176   state sub se ($);
177   is prototype eval{\&se}, '$', 'state sub with proto';
178   is prototype "se", undef, 'prototype "..." ignores state subs';
179 }
180 {
181   state sub if() { 44 }
182   my $x = if if if;
183   is $x, 44, 'state subs override all keywords';
184   package bar;
185   my $y = if if if;
186   is $y, 44, 'state subs from other packages override all keywords';
187 }
188 {
189   use warnings;
190   state $w ;
191   local $SIG{__WARN__} = sub { $w .= shift };
192   eval '#line 87 squidges
193     state sub foo;
194     state sub foo {};
195   ';
196 on;
197   is $w,
198      '"state" subroutine foo masks earlier declaration in same scope at '
199    . "squidges line 88.\n",
200      'redefinition warning for state sub';
201 off;
202 }
203 # Since state vars inside anonymous subs are cloned at the same time as the
204 # anonymous subs containing them, the same should happen for state subs.
205 sub make_closure {
206   state $x = shift;
207   sub {
208     state sub foo { $x }
209     eval {foo}
210   }
211 }
212 $sub1 = make_closure 48;
213 $sub2 = make_closure 49;
214 is &$sub1, 48, 'state sub in closure (1)';
215 on;
216 is &$sub2, 49, 'state sub in closure (2)';
217 off;
218 # But we need to test that state subs actually do persist from one invoca-
219 # tion of a named sub to another (i.e., that they are not my subs).
220 {
221   use warnings;
222   state $w;
223   local $SIG{__WARN__} = sub { $w .= shift };
224   eval '#line 65 teetet
225     sub foom {
226       my $x = shift;
227       state sub poom { $x }
228       eval{\&poom}
229     }
230   ';
231   is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
232          'state subs get "Variable will not stay shared" messages';
233   my $poom = foom(27);
234   my $poom2 = foom(678);
235   is eval{$poom->()}, eval {$poom2->()},
236     'state subs close over the first outer my var, like pkg subs';
237   my $x = 43;
238   for $x (765) {
239     state sub etetetet { $x }
240 on;
241     is eval{etetetet}, $x, 'state sub ignores for() localisation';
242 off;
243   }
244 }
245 {
246   state sub BEGIN { exit };
247   pass 'state subs are never special blocks';
248   state sub END { shift }
249   is eval{END('jkqeudth')}, jkqeudth,
250     'state sub END {shift} implies @_, not @ARGV';
251 }
252 {
253   state sub redef {}
254   use warnings;
255   state $w;
256   local $SIG{__WARN__} = sub { $w .= shift };
257   eval "#line 56 pygpyf\nsub redef {}";
258 on;
259   is $w, "Subroutine redef redefined at pygpyf line 56.\n",
260          "sub redefinition warnings from state subs";
261 }