This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
de5db9694919bb6dbefee41ce53f6c7e0a0fcd2a
[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      eval "
142       is sb2, 44, 'state sub visible inside itself after decl';
143       is &sb2, 44, 'state sub visible inside itself after decl (amper)';
144       is do sb2(), 44, 'state sub visible inside itself after decl (do)';
145      ";
146     }
147     44
148   }
149 SKIP: { ::skip "Assertion failure", 3;
150   sb2(1);
151 }
152   state sub sb3;
153   {
154     state sub sb3 { # new pad entry
155       # The sub containing this comment is invisible inside itself.
156       # So this one here will assign to the outer pad entry:
157       sub sb3 { 47 }
158     }
159   }
160   is eval{sb3}, 47,
161     'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
162 }
163 sub sc { 43 }
164 {
165   state sub sc;
166   eval{sc};
167 ::on;
168   like $@, qr/^Undefined subroutine &sb called at /,
169      'state sub foo; makes no lex alias for existing sub';
170   eval{&sc};
171   like $@, qr/^Undefined subroutine &sb called at /,
172      'state sub foo; makes no lex alias for existing sub (amper)';
173   eval{do sc()};
174   like $@, qr/^Undefined subroutine &sb called at /,
175      'state sub foo; makes no lex alias for existing sub (do)';
176 ::off;
177 }
178 package main;
179 {
180   state sub se ($);
181   is prototype eval{\&se}, '$', 'state sub with proto';
182   is prototype "se", undef, 'prototype "..." ignores state subs';
183 }
184 {
185   state sub if() { 44 }
186   my $x = if if if;
187   is $x, 44, 'state subs override all keywords';
188   package bar;
189   my $y = if if if;
190   is $y, 44, 'state subs from other packages override all keywords';
191 }
192 {
193   use warnings;
194   state $w ;
195   local $SIG{__WARN__} = sub { $w .= shift };
196   eval '#line 87 squidges
197     state sub foo;
198     state sub foo {};
199   ';
200 on;
201   is $w,
202      '"state" subroutine foo masks earlier declaration in same scope at '
203    . "squidges line 88.\n",
204      'redefinition warning for state sub';
205 off;
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.
209 sub make_closure {
210   state $x = shift;
211   sub {
212     state sub foo { $x }
213     eval {foo}
214   }
215 }
216 $sub1 = make_closure 48;
217 $sub2 = make_closure 49;
218 is &$sub1, 48, 'state sub in closure (1)';
219 on;
220 is &$sub2, 49, 'state sub in closure (2)';
221 off;
222 # But we need to test that state subs actually do persist from one invoca-
223 # tion of a named sub to another (i.e., that they are not my subs).
224 {
225   use warnings;
226   state $w;
227   local $SIG{__WARN__} = sub { $w .= shift };
228   eval '#line 65 teetet
229     sub foom {
230       my $x = shift;
231       state sub poom { $x }
232       eval{\&poom}
233     }
234   ';
235   is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
236          'state subs get "Variable will not stay shared" messages';
237   my $poom = foom(27);
238   my $poom2 = foom(678);
239   is eval{$poom->()}, eval {$poom2->()},
240     'state subs close over the first outer my var, like pkg subs';
241   my $x = 43;
242   for $x (765) {
243     state sub etetetet { $x }
244 on;
245     is eval{etetetet}, $x, 'state sub ignores for() localisation';
246 off;
247   }
248 }
249 {
250   state sub BEGIN { exit };
251   pass 'state subs are never special blocks';
252   state sub END { shift }
253   is eval{END('jkqeudth')}, jkqeudth,
254     'state sub END {shift} implies @_, not @ARGV';
255 }
256 {
257   state sub redef {}
258   use warnings;
259   state $w;
260   local $SIG{__WARN__} = sub { $w .= shift };
261   eval "#line 56 pygpyf\nsub redef {}";
262 on;
263   is $w, "Subroutine redef redefined at pygpyf line 56.\n",
264          "sub redefinition warnings from state subs";
265 }