Commit | Line | Data |
---|---|---|
c07656ed FC |
1 | #!perl |
2 | ||
39075fb1 FC |
3 | BEGIN { |
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 | 10 | no warnings 'deprecated'; |
21452252 FC |
11 | plan 58; |
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 | } |
26 | package bar; | |
39075fb1 FC |
27 | is foo, 43, 'our sub falling out of scope'; |
28 | is &foo, 43, 'our sub falling out of scope (called via amper)'; | |
4b473a5a | 29 | is do foo(), 43, 'our sub falling out of scope (called via amper)'; |
c07656ed FC |
30 | package 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 | } | |
56 | sub c { 42 } | |
57 | sub 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 | ||
87 | sub on { $::TODO = ' ' } | |
88 | sub off { $::TODO = undef } | |
89 | ||
90 | use 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 |
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 | } | |
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 | } | |
159 | sub sc { 43 } | |
160 | { | |
161 | state sub sc; | |
162 | eval{sc}; | |
97b03d64 | 163 | ::on; |
21452252 FC |
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)'; | |
97b03d64 | 172 | ::off; |
21452252 FC |
173 | } |
174 | package main; | |
175 | { | |
176 | state sub se ($); | |
177 | is prototype eval{\&se}, '$', 'state sub with proto'; | |
21452252 FC |
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'; | |
97b03d64 | 201 | off; |
21452252 FC |
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)'; | |
97b03d64 FC |
215 | on; |
216 | is &$sub2, 49, 'state sub in closure (2)'; | |
21452252 FC |
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 } | |
21452252 FC |
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 {}"; | |
97b03d64 | 258 | on; |
21452252 FC |
259 | is $w, "Subroutine redef redefined at pygpyf line 56.\n", |
260 | "sub redefinition warnings from state subs"; | |
261 | } |