Commit | Line | Data |
---|---|---|
30d9c59b Z |
1 | #!perl |
2 | ||
3 | BEGIN { | |
a817e89d | 4 | chdir 't' if -d 't'; |
30d9c59b | 5 | require './test.pl'; |
1ccc3f31 | 6 | set_up_inc('../lib'); |
30d9c59b | 7 | } |
30d9c59b | 8 | |
71986b33 DM |
9 | use warnings; |
10 | use strict; | |
30d9c59b Z |
11 | |
12 | our $a = 123; | |
13 | our $z; | |
14 | ||
71986b33 DM |
15 | { |
16 | no warnings "illegalproto"; | |
17 | sub t000 ($a) { $a || "z" } | |
18 | is prototype(\&t000), "\$a", "(\$a) interpreted as protoype when not enabled"; | |
19 | is &t000(456), 123, "(\$a) not signature when not enabled"; | |
20 | is $a, 123; | |
21 | } | |
30d9c59b | 22 | |
894f226e | 23 | eval "#line 8 foo\nsub t004 :method (\$a) { }"; |
75230cc1 | 24 | like $@, qr{syntax error at foo line 8}, "error when not enabled 1"; |
894f226e DM |
25 | |
26 | eval "#line 8 foo\nsub t005 (\$) (\$a) { }"; | |
75230cc1 | 27 | like $@, qr{syntax error at foo line 8}, "error when not enabled 2"; |
894f226e DM |
28 | |
29 | ||
30d9c59b Z |
30 | use feature "signatures"; |
31 | ||
32 | sub t001 { $a || "z" } | |
33 | is prototype(\&t001), undef; | |
34 | is eval("t001()"), 123; | |
35 | is eval("t001(456)"), 123; | |
36 | is eval("t001(456, 789)"), 123; | |
37 | is $a, 123; | |
38 | ||
0f14f058 FG |
39 | sub _create_mismatch_regexp { |
40 | my ($funcname, $got, $expected, $flexible_str) = @_; | |
41 | ||
42 | my $many_few_str = ($got > $expected) ? 'many' : 'few'; | |
43 | ||
44 | $flexible_str //= q<>; | |
45 | ||
46 | return qr/\AToo $many_few_str arguments for subroutine '$funcname' \(got $got; expected $flexible_str$expected\) at \(eval \d+\) line 1\.\n\z/; | |
47 | } | |
48 | ||
49 | sub _create_flexible_mismatch_regexp { | |
50 | my ($funcname, $got, $expected) = @_; | |
51 | ||
52 | my $flexible_str = ($got > $expected) ? 'at most' : 'at least'; | |
53 | $flexible_str .= q< >; | |
54 | ||
55 | return _create_mismatch_regexp($funcname, $got, $expected, $flexible_str); | |
56 | } | |
57 | ||
30d9c59b Z |
58 | sub t002 () { $a || "z" } |
59 | is prototype(\&t002), undef; | |
60 | is eval("t002()"), 123; | |
61 | is eval("t002(456)"), undef; | |
0f14f058 | 62 | like $@, _create_mismatch_regexp('main::t002', 1, 0); |
30d9c59b | 63 | is eval("t002(456, 789)"), undef; |
0f14f058 | 64 | like $@, _create_mismatch_regexp('main::t002', 2, 0); |
30d9c59b Z |
65 | is $a, 123; |
66 | ||
67 | sub t003 ( ) { $a || "z" } | |
68 | is prototype(\&t003), undef; | |
69 | is eval("t003()"), 123; | |
70 | is eval("t003(456)"), undef; | |
0f14f058 | 71 | like $@, _create_mismatch_regexp('main::t003', 1, 0); |
30d9c59b | 72 | is eval("t003(456, 789)"), undef; |
0f14f058 | 73 | like $@, _create_mismatch_regexp('main::t003', 2, 0); |
30d9c59b Z |
74 | is $a, 123; |
75 | ||
76 | sub t006 ($a) { $a || "z" } | |
77 | is prototype(\&t006), undef; | |
78 | is eval("t006()"), undef; | |
0f14f058 | 79 | like $@, _create_mismatch_regexp('main::t006', 0, 1); |
30d9c59b Z |
80 | is eval("t006(0)"), "z"; |
81 | is eval("t006(456)"), 456; | |
82 | is eval("t006(456, 789)"), undef; | |
0f14f058 | 83 | like $@, _create_mismatch_regexp('main::t006', 2, 1); |
30d9c59b | 84 | is eval("t006(456, 789, 987)"), undef; |
0f14f058 | 85 | like $@, _create_mismatch_regexp('main::t006', 3, 1); |
30d9c59b Z |
86 | is $a, 123; |
87 | ||
88 | sub t007 ($a, $b) { $a.$b } | |
89 | is prototype(\&t007), undef; | |
90 | is eval("t007()"), undef; | |
0f14f058 | 91 | like $@, _create_mismatch_regexp('main::t007', 0, 2); |
30d9c59b | 92 | is eval("t007(456)"), undef; |
0f14f058 | 93 | like $@, _create_mismatch_regexp('main::t007', 1, 2); |
30d9c59b Z |
94 | is eval("t007(456, 789)"), "456789"; |
95 | is eval("t007(456, 789, 987)"), undef; | |
0f14f058 | 96 | like $@, _create_mismatch_regexp('main::t007', 3, 2); |
30d9c59b | 97 | is eval("t007(456, 789, 987, 654)"), undef; |
0f14f058 | 98 | like $@, _create_mismatch_regexp('main::t007', 4, 2); |
30d9c59b Z |
99 | is $a, 123; |
100 | ||
101 | sub t008 ($a, $b, $c) { $a.$b.$c } | |
102 | is prototype(\&t008), undef; | |
103 | is eval("t008()"), undef; | |
0f14f058 | 104 | like $@, _create_mismatch_regexp('main::t008', 0, 3); |
30d9c59b | 105 | is eval("t008(456)"), undef; |
0f14f058 | 106 | like $@, _create_mismatch_regexp('main::t008', 1, 3); |
30d9c59b | 107 | is eval("t008(456, 789)"), undef; |
0f14f058 | 108 | like $@, _create_mismatch_regexp('main::t008', 2, 3); |
30d9c59b Z |
109 | is eval("t008(456, 789, 987)"), "456789987"; |
110 | is eval("t008(456, 789, 987, 654)"), undef; | |
0f14f058 | 111 | like $@, _create_mismatch_regexp('main::t008', 4, 3); |
30d9c59b Z |
112 | is $a, 123; |
113 | ||
114 | sub t009 ($abc, $def) { $abc.$def } | |
115 | is prototype(\&t009), undef; | |
116 | is eval("t009()"), undef; | |
0f14f058 | 117 | like $@, _create_mismatch_regexp('main::t009', 0, 2); |
30d9c59b | 118 | is eval("t009(456)"), undef; |
0f14f058 | 119 | like $@, _create_mismatch_regexp('main::t009', 1, 2); |
30d9c59b Z |
120 | is eval("t009(456, 789)"), "456789"; |
121 | is eval("t009(456, 789, 987)"), undef; | |
0f14f058 | 122 | like $@, _create_mismatch_regexp('main::t009', 3, 2); |
30d9c59b | 123 | is eval("t009(456, 789, 987, 654)"), undef; |
0f14f058 | 124 | like $@, _create_mismatch_regexp('main::t009', 4, 2); |
30d9c59b Z |
125 | is $a, 123; |
126 | ||
127 | sub t010 ($a, $) { $a || "z" } | |
128 | is prototype(\&t010), undef; | |
129 | is eval("t010()"), undef; | |
0f14f058 | 130 | like $@, _create_mismatch_regexp('main::t010', 0, 2); |
30d9c59b | 131 | is eval("t010(456)"), undef; |
0f14f058 | 132 | like $@, _create_mismatch_regexp('main::t010', 1, 2); |
30d9c59b Z |
133 | is eval("t010(0, 789)"), "z"; |
134 | is eval("t010(456, 789)"), 456; | |
135 | is eval("t010(456, 789, 987)"), undef; | |
0f14f058 | 136 | like $@, _create_mismatch_regexp('main::t010', 3, 2); |
30d9c59b | 137 | is eval("t010(456, 789, 987, 654)"), undef; |
0f14f058 | 138 | like $@, _create_mismatch_regexp('main::t010', 4, 2); |
30d9c59b Z |
139 | is $a, 123; |
140 | ||
141 | sub t011 ($, $a) { $a || "z" } | |
142 | is prototype(\&t011), undef; | |
143 | is eval("t011()"), undef; | |
0f14f058 | 144 | like $@, _create_mismatch_regexp('main::t011', 0, 2); |
30d9c59b | 145 | is eval("t011(456)"), undef; |
0f14f058 | 146 | like $@, _create_mismatch_regexp('main::t011', 1, 2); |
30d9c59b Z |
147 | is eval("t011(456, 0)"), "z"; |
148 | is eval("t011(456, 789)"), 789; | |
149 | is eval("t011(456, 789, 987)"), undef; | |
0f14f058 | 150 | like $@, _create_mismatch_regexp('main::t011', 3, 2); |
30d9c59b | 151 | is eval("t011(456, 789, 987, 654)"), undef; |
0f14f058 | 152 | like $@, _create_mismatch_regexp('main::t011', 4, 2); |
30d9c59b Z |
153 | is $a, 123; |
154 | ||
155 | sub t012 ($, $) { $a || "z" } | |
156 | is prototype(\&t012), undef; | |
157 | is eval("t012()"), undef; | |
0f14f058 | 158 | like $@, _create_mismatch_regexp('main::t012', 0, 2); |
30d9c59b | 159 | is eval("t012(456)"), undef; |
0f14f058 | 160 | like $@, _create_mismatch_regexp('main::t012', 1, 2); |
30d9c59b Z |
161 | is eval("t012(0, 789)"), 123; |
162 | is eval("t012(456, 789)"), 123; | |
163 | is eval("t012(456, 789, 987)"), undef; | |
0f14f058 | 164 | like $@, _create_mismatch_regexp('main::t012', 3, 2); |
30d9c59b | 165 | is eval("t012(456, 789, 987, 654)"), undef; |
0f14f058 | 166 | like $@, _create_mismatch_regexp('main::t012', 4, 2); |
30d9c59b Z |
167 | is $a, 123; |
168 | ||
169 | sub t013 ($) { $a || "z" } | |
170 | is prototype(\&t013), undef; | |
171 | is eval("t013()"), undef; | |
0f14f058 | 172 | like $@, _create_mismatch_regexp('main::t013', 0, 1); |
30d9c59b Z |
173 | is eval("t013(0)"), 123; |
174 | is eval("t013(456)"), 123; | |
175 | is eval("t013(456, 789)"), undef; | |
0f14f058 | 176 | like $@, _create_mismatch_regexp('main::t013', 2, 1); |
30d9c59b | 177 | is eval("t013(456, 789, 987)"), undef; |
0f14f058 | 178 | like $@, _create_mismatch_regexp('main::t013', 3, 1); |
30d9c59b | 179 | is eval("t013(456, 789, 987, 654)"), undef; |
0f14f058 | 180 | like $@, _create_mismatch_regexp('main::t013', 4, 1); |
30d9c59b Z |
181 | is $a, 123; |
182 | ||
183 | sub t014 ($a = 222) { $a // "z" } | |
184 | is prototype(\&t014), undef; | |
185 | is eval("t014()"), 222; | |
186 | is eval("t014(0)"), 0; | |
187 | is eval("t014(undef)"), "z"; | |
188 | is eval("t014(456)"), 456; | |
189 | is eval("t014(456, 789)"), undef; | |
0f14f058 | 190 | like $@, _create_flexible_mismatch_regexp('main::t014', 2, 1); |
30d9c59b | 191 | is eval("t014(456, 789, 987)"), undef; |
0f14f058 | 192 | like $@, _create_flexible_mismatch_regexp('main::t014', 3, 1); |
30d9c59b Z |
193 | is $a, 123; |
194 | ||
195 | sub t015 ($a = undef) { $a // "z" } | |
196 | is prototype(\&t015), undef; | |
197 | is eval("t015()"), "z"; | |
198 | is eval("t015(0)"), 0; | |
199 | is eval("t015(undef)"), "z"; | |
200 | is eval("t015(456)"), 456; | |
201 | is eval("t015(456, 789)"), undef; | |
0f14f058 | 202 | like $@, _create_flexible_mismatch_regexp('main::t015', 2, 1); |
30d9c59b | 203 | is eval("t015(456, 789, 987)"), undef; |
0f14f058 | 204 | like $@, _create_flexible_mismatch_regexp('main::t015', 3, 1); |
30d9c59b Z |
205 | is $a, 123; |
206 | ||
207 | sub t016 ($a = do { $z++; 222 }) { $a // "z" } | |
208 | $z = 0; | |
209 | is prototype(\&t016), undef; | |
210 | is eval("t016()"), 222; | |
211 | is $z, 1; | |
212 | is eval("t016(0)"), 0; | |
213 | is eval("t016(undef)"), "z"; | |
214 | is eval("t016(456)"), 456; | |
215 | is eval("t016(456, 789)"), undef; | |
0f14f058 | 216 | like $@, _create_flexible_mismatch_regexp('main::t016', 2, 1); |
30d9c59b | 217 | is eval("t016(456, 789, 987)"), undef; |
0f14f058 | 218 | like $@, _create_flexible_mismatch_regexp('main::t016', 3, 1); |
30d9c59b Z |
219 | is $z, 1; |
220 | is eval("t016()"), 222; | |
221 | is $z, 2; | |
222 | is $a, 123; | |
223 | ||
224 | sub t018 { join("/", @_) } | |
225 | sub t017 ($p = t018 222, $a = 333) { $p // "z" } | |
226 | is prototype(\&t017), undef; | |
227 | is eval("t017()"), "222/333"; | |
228 | is $a, 333; | |
229 | $a = 123; | |
230 | is eval("t017(0)"), 0; | |
231 | is eval("t017(undef)"), "z"; | |
232 | is eval("t017(456)"), 456; | |
233 | is eval("t017(456, 789)"), undef; | |
0f14f058 | 234 | like $@, _create_flexible_mismatch_regexp('main::t017', 2, 1); |
30d9c59b | 235 | is eval("t017(456, 789, 987)"), undef; |
0f14f058 | 236 | like $@, _create_flexible_mismatch_regexp('main::t017', 3, 1); |
30d9c59b Z |
237 | is $a, 123; |
238 | ||
239 | sub t019 ($p = 222, $a = 333) { "$p/$a" } | |
240 | is prototype(\&t019), undef; | |
241 | is eval("t019()"), "222/333"; | |
242 | is eval("t019(0)"), "0/333"; | |
243 | is eval("t019(456)"), "456/333"; | |
244 | is eval("t019(456, 789)"), "456/789"; | |
245 | is eval("t019(456, 789, 987)"), undef; | |
0f14f058 | 246 | like $@, _create_flexible_mismatch_regexp('main::t019', 3, 2); |
30d9c59b Z |
247 | is $a, 123; |
248 | ||
249 | sub t020 :prototype($) { $_[0]."z" } | |
250 | sub t021 ($p = t020 222, $a = 333) { "$p/$a" } | |
251 | is prototype(\&t021), undef; | |
252 | is eval("t021()"), "222z/333"; | |
253 | is eval("t021(0)"), "0/333"; | |
254 | is eval("t021(456)"), "456/333"; | |
255 | is eval("t021(456, 789)"), "456/789"; | |
256 | is eval("t021(456, 789, 987)"), undef; | |
0f14f058 | 257 | like $@, _create_flexible_mismatch_regexp('main::t021', 3, 2); |
30d9c59b Z |
258 | is $a, 123; |
259 | ||
260 | sub t022 ($p = do { $z += 10; 222 }, $a = do { $z++; 333 }) { "$p/$a" } | |
261 | $z = 0; | |
262 | is prototype(\&t022), undef; | |
263 | is eval("t022()"), "222/333"; | |
264 | is $z, 11; | |
265 | is eval("t022(0)"), "0/333"; | |
266 | is $z, 12; | |
267 | is eval("t022(456)"), "456/333"; | |
268 | is $z, 13; | |
269 | is eval("t022(456, 789)"), "456/789"; | |
270 | is eval("t022(456, 789, 987)"), undef; | |
0f14f058 | 271 | like $@, _create_flexible_mismatch_regexp('main::t022', 3, 2); |
30d9c59b Z |
272 | is $z, 13; |
273 | is $a, 123; | |
274 | ||
275 | sub t023 ($a = sub { $_[0]."z" }) { $a->("a")."y" } | |
276 | is prototype(\&t023), undef; | |
277 | is eval("t023()"), "azy"; | |
278 | is eval("t023(sub { \"x\".\$_[0].\"x\" })"), "xaxy"; | |
279 | is eval("t023(sub { \"x\".\$_[0].\"x\" }, 789)"), undef; | |
0f14f058 | 280 | like $@, _create_flexible_mismatch_regexp('main::t023', 2, 1); |
30d9c59b Z |
281 | is $a, 123; |
282 | ||
283 | sub t036 ($a = $a."x") { $a."y" } | |
284 | is prototype(\&t036), undef; | |
285 | is eval("t036()"), "123xy"; | |
286 | is eval("t036(0)"), "0y"; | |
287 | is eval("t036(456)"), "456y"; | |
288 | is eval("t036(456, 789)"), undef; | |
0f14f058 | 289 | like $@, _create_flexible_mismatch_regexp('main::t036', 2, 1); |
30d9c59b Z |
290 | is $a, 123; |
291 | ||
acf0afbd Z |
292 | sub t120 ($a = $_) { $a // "z" } |
293 | is prototype(\&t120), undef; | |
294 | $_ = "___"; | |
295 | is eval("t120()"), "___"; | |
296 | $_ = "___"; | |
297 | is eval("t120(undef)"), "z"; | |
298 | $_ = "___"; | |
299 | is eval("t120(0)"), 0; | |
300 | $_ = "___"; | |
301 | is eval("t120(456)"), 456; | |
302 | $_ = "___"; | |
303 | is eval("t120(456, 789)"), undef; | |
0f14f058 | 304 | like $@, _create_flexible_mismatch_regexp('main::t120', 2, 1); |
acf0afbd Z |
305 | is $a, 123; |
306 | ||
307 | sub t121 ($a = caller) { $a // "z" } | |
308 | is prototype(\&t121), undef; | |
309 | is eval("t121()"), "main"; | |
310 | is eval("t121(undef)"), "z"; | |
311 | is eval("t121(0)"), 0; | |
312 | is eval("t121(456)"), 456; | |
313 | is eval("t121(456, 789)"), undef; | |
0f14f058 | 314 | like $@, _create_flexible_mismatch_regexp('main::t121', 2, 1); |
acf0afbd Z |
315 | is eval("package T121::Z; ::t121()"), "T121::Z"; |
316 | is eval("package T121::Z; ::t121(undef)"), "z"; | |
317 | is eval("package T121::Z; ::t121(0)"), 0; | |
318 | is eval("package T121::Z; ::t121(456)"), 456; | |
319 | is eval("package T121::Z; ::t121(456, 789)"), undef; | |
0f14f058 | 320 | like $@, _create_flexible_mismatch_regexp('main::t121', 2, 1); |
acf0afbd Z |
321 | is $a, 123; |
322 | ||
323 | sub t129 ($a = return 222) { $a."x" } | |
324 | is prototype(\&t129), undef; | |
325 | is eval("t129()"), "222"; | |
326 | is eval("t129(0)"), "0x"; | |
327 | is eval("t129(456)"), "456x"; | |
328 | is eval("t129(456, 789)"), undef; | |
0f14f058 | 329 | like $@, _create_flexible_mismatch_regexp('main::t129', 2, 1); |
acf0afbd Z |
330 | is $a, 123; |
331 | ||
332 | use feature "current_sub"; | |
333 | sub t122 ($c = 5, $r = $c > 0 ? __SUB__->($c - 1) : "") { $c.$r } | |
334 | is prototype(\&t122), undef; | |
335 | is eval("t122()"), "543210"; | |
336 | is eval("t122(0)"), "0"; | |
337 | is eval("t122(1)"), "10"; | |
338 | is eval("t122(5)"), "543210"; | |
339 | is eval("t122(5, 789)"), "5789"; | |
340 | is eval("t122(5, 789, 987)"), undef; | |
0f14f058 | 341 | like $@, _create_flexible_mismatch_regexp('main::t122', 3, 2); |
acf0afbd Z |
342 | is $a, 123; |
343 | ||
344 | sub t123 ($list = wantarray) { $list ? "list" : "scalar" } | |
345 | is prototype(\&t123), undef; | |
346 | is eval("scalar(t123())"), "scalar"; | |
347 | is eval("(t123())[0]"), "list"; | |
348 | is eval("scalar(t123(0))"), "scalar"; | |
349 | is eval("(t123(0))[0]"), "scalar"; | |
350 | is eval("scalar(t123(1))"), "list"; | |
351 | is eval("(t123(1))[0]"), "list"; | |
352 | is eval("t123(456, 789)"), undef; | |
0f14f058 | 353 | like $@, _create_flexible_mismatch_regexp('main::t123', 2, 1); |
acf0afbd Z |
354 | is $a, 123; |
355 | ||
356 | sub t124 ($b = (local $a = $a + 1)) { "$a/$b" } | |
357 | is prototype(\&t124), undef; | |
358 | is eval("t124()"), "124/124"; | |
359 | is $a, 123; | |
360 | is eval("t124(456)"), "123/456"; | |
361 | is $a, 123; | |
362 | is eval("t124(456, 789)"), undef; | |
0f14f058 | 363 | like $@, _create_flexible_mismatch_regexp('main::t124', 2, 1); |
acf0afbd Z |
364 | is $a, 123; |
365 | ||
366 | sub t125 ($c = (our $t125_counter)++) { $c } | |
367 | is prototype(\&t125), undef; | |
368 | is eval("t125()"), 0; | |
369 | is eval("t125()"), 1; | |
370 | is eval("t125()"), 2; | |
371 | is eval("t125(456)"), 456; | |
372 | is eval("t125(789)"), 789; | |
373 | is eval("t125()"), 3; | |
374 | is eval("t125()"), 4; | |
375 | is eval("t125(456, 789)"), undef; | |
0f14f058 | 376 | like $@, _create_flexible_mismatch_regexp('main::t125', 2, 1); |
acf0afbd Z |
377 | is $a, 123; |
378 | ||
379 | use feature "state"; | |
380 | sub t126 ($c = (state $s = $z++)) { $c } | |
381 | is prototype(\&t126), undef; | |
382 | $z = 222; | |
383 | is eval("t126(456)"), 456; | |
384 | is $z, 222; | |
385 | is eval("t126()"), 222; | |
386 | is $z, 223; | |
387 | is eval("t126(456)"), 456; | |
388 | is $z, 223; | |
389 | is eval("t126()"), 222; | |
390 | is $z, 223; | |
391 | is eval("t126(456, 789)"), undef; | |
0f14f058 | 392 | like $@, _create_flexible_mismatch_regexp('main::t126', 2, 1); |
acf0afbd Z |
393 | is $z, 223; |
394 | is $a, 123; | |
395 | ||
396 | sub t127 ($c = do { state $s = $z++; $s++ }) { $c } | |
397 | is prototype(\&t127), undef; | |
398 | $z = 222; | |
399 | is eval("t127(456)"), 456; | |
400 | is $z, 222; | |
401 | is eval("t127()"), 222; | |
402 | is $z, 223; | |
403 | is eval("t127()"), 223; | |
404 | is eval("t127()"), 224; | |
405 | is $z, 223; | |
406 | is eval("t127(456)"), 456; | |
407 | is eval("t127(789)"), 789; | |
408 | is eval("t127()"), 225; | |
409 | is eval("t127()"), 226; | |
410 | is eval("t127(456, 789)"), undef; | |
0f14f058 | 411 | like $@, _create_flexible_mismatch_regexp('main::t127', 2, 1); |
acf0afbd Z |
412 | is $z, 223; |
413 | is $a, 123; | |
414 | ||
30d9c59b Z |
415 | sub t037 ($a = 222, $b = $a."x") { "$a/$b" } |
416 | is prototype(\&t037), undef; | |
417 | is eval("t037()"), "222/222x"; | |
418 | is eval("t037(0)"), "0/0x"; | |
419 | is eval("t037(456)"), "456/456x"; | |
420 | is eval("t037(456, 789)"), "456/789"; | |
421 | is eval("t037(456, 789, 987)"), undef; | |
0f14f058 | 422 | like $@, _create_flexible_mismatch_regexp('main::t037', 3, 2); |
30d9c59b Z |
423 | is $a, 123; |
424 | ||
acf0afbd Z |
425 | sub t128 ($a = 222, $b = ($a = 333)) { "$a/$b" } |
426 | is prototype(\&t128), undef; | |
427 | is eval("t128()"), "333/333"; | |
428 | is eval("t128(0)"), "333/333"; | |
429 | is eval("t128(456)"), "333/333"; | |
430 | is eval("t128(456, 789)"), "456/789"; | |
431 | is eval("t128(456, 789, 987)"), undef; | |
0f14f058 | 432 | like $@, _create_flexible_mismatch_regexp('main::t128', 3, 2); |
acf0afbd Z |
433 | is $a, 123; |
434 | ||
435 | sub t130 { join(",", @_).";".scalar(@_) } | |
40151a41 PE |
436 | { |
437 | no warnings 'experimental::args_array_with_signatures'; | |
438 | sub t131 ($a = 222, $b = goto &t130) { "$a/$b" } | |
439 | } | |
acf0afbd Z |
440 | is prototype(\&t131), undef; |
441 | is eval("t131()"), ";0"; | |
442 | is eval("t131(0)"), "0;1"; | |
443 | is eval("t131(456)"), "456;1"; | |
444 | is eval("t131(456, 789)"), "456/789"; | |
445 | is eval("t131(456, 789, 987)"), undef; | |
0f14f058 | 446 | like $@, _create_flexible_mismatch_regexp('main::t131', 3, 2); |
acf0afbd Z |
447 | is $a, 123; |
448 | ||
30d9c59b | 449 | eval "#line 8 foo\nsub t024 (\$a =) { }"; |
d3d9da4a DM |
450 | is $@, |
451 | qq{Optional parameter lacks default expression at foo line 8, near "=) "\n}; | |
30d9c59b Z |
452 | |
453 | sub t025 ($ = undef) { $a // "z" } | |
454 | is prototype(\&t025), undef; | |
455 | is eval("t025()"), 123; | |
456 | is eval("t025(0)"), 123; | |
457 | is eval("t025(456)"), 123; | |
458 | is eval("t025(456, 789)"), undef; | |
0f14f058 | 459 | like $@, _create_flexible_mismatch_regexp('main::t025', 2, 1); |
30d9c59b | 460 | is eval("t025(456, 789, 987)"), undef; |
0f14f058 | 461 | like $@, _create_flexible_mismatch_regexp('main::t025', 3, 1); |
30d9c59b | 462 | is eval("t025(456, 789, 987, 654)"), undef; |
0f14f058 | 463 | like $@, _create_flexible_mismatch_regexp('main::t025', 4, 1); |
30d9c59b Z |
464 | is $a, 123; |
465 | ||
466 | sub t026 ($ = 222) { $a // "z" } | |
467 | is prototype(\&t026), undef; | |
468 | is eval("t026()"), 123; | |
469 | is eval("t026(0)"), 123; | |
470 | is eval("t026(456)"), 123; | |
471 | is eval("t026(456, 789)"), undef; | |
0f14f058 | 472 | like $@, _create_flexible_mismatch_regexp('main::t026', 2, 1); |
30d9c59b | 473 | is eval("t026(456, 789, 987)"), undef; |
0f14f058 | 474 | like $@, _create_flexible_mismatch_regexp('main::t026', 3, 1); |
30d9c59b | 475 | is eval("t026(456, 789, 987, 654)"), undef; |
0f14f058 | 476 | like $@, _create_flexible_mismatch_regexp('main::t026', 4, 1); |
30d9c59b Z |
477 | is $a, 123; |
478 | ||
479 | sub t032 ($ = do { $z++; 222 }) { $a // "z" } | |
480 | $z = 0; | |
481 | is prototype(\&t032), undef; | |
482 | is eval("t032()"), 123; | |
483 | is $z, 1; | |
484 | is eval("t032(0)"), 123; | |
485 | is eval("t032(456)"), 123; | |
486 | is eval("t032(456, 789)"), undef; | |
0f14f058 | 487 | like $@, _create_flexible_mismatch_regexp('main::t032', 2, 1); |
30d9c59b | 488 | is eval("t032(456, 789, 987)"), undef; |
0f14f058 | 489 | like $@, _create_flexible_mismatch_regexp('main::t032', 3, 1); |
30d9c59b | 490 | is eval("t032(456, 789, 987, 654)"), undef; |
0f14f058 | 491 | like $@, _create_flexible_mismatch_regexp('main::t032', 4, 1); |
30d9c59b Z |
492 | is $z, 1; |
493 | is $a, 123; | |
494 | ||
495 | sub t027 ($ =) { $a // "z" } | |
496 | is prototype(\&t027), undef; | |
497 | is eval("t027()"), 123; | |
498 | is eval("t027(0)"), 123; | |
499 | is eval("t027(456)"), 123; | |
500 | is eval("t027(456, 789)"), undef; | |
0f14f058 | 501 | like $@, _create_flexible_mismatch_regexp('main::t027', 2, 1); |
30d9c59b | 502 | is eval("t027(456, 789, 987)"), undef; |
0f14f058 | 503 | like $@, _create_flexible_mismatch_regexp('main::t027', 3, 1); |
30d9c59b | 504 | is eval("t027(456, 789, 987, 654)"), undef; |
0f14f058 | 505 | like $@, _create_flexible_mismatch_regexp('main::t027', 4, 1); |
30d9c59b Z |
506 | is $a, 123; |
507 | ||
508 | sub t119 ($ =, $a = 333) { $a // "z" } | |
509 | is prototype(\&t119), undef; | |
510 | is eval("t119()"), 333; | |
511 | is eval("t119(0)"), 333; | |
512 | is eval("t119(456)"), 333; | |
513 | is eval("t119(456, 789)"), 789; | |
514 | is eval("t119(456, 789, 987)"), undef; | |
0f14f058 | 515 | like $@, _create_flexible_mismatch_regexp('main::t119', 3, 2); |
30d9c59b | 516 | is eval("t119(456, 789, 987, 654)"), undef; |
0f14f058 | 517 | like $@, _create_flexible_mismatch_regexp('main::t119', 4, 2); |
30d9c59b Z |
518 | is $a, 123; |
519 | ||
520 | sub t028 ($a, $b = 333) { "$a/$b" } | |
521 | is prototype(\&t028), undef; | |
522 | is eval("t028()"), undef; | |
0f14f058 | 523 | like $@, _create_flexible_mismatch_regexp('main::t028', 0, 1); |
30d9c59b Z |
524 | is eval("t028(0)"), "0/333"; |
525 | is eval("t028(456)"), "456/333"; | |
526 | is eval("t028(456, 789)"), "456/789"; | |
527 | is eval("t028(456, 789, 987)"), undef; | |
0f14f058 | 528 | like $@, _create_flexible_mismatch_regexp('main::t028', 3, 2); |
30d9c59b Z |
529 | is $a, 123; |
530 | ||
531 | sub t045 ($a, $ = 333) { "$a/" } | |
532 | is prototype(\&t045), undef; | |
533 | is eval("t045()"), undef; | |
0f14f058 | 534 | like $@, _create_flexible_mismatch_regexp('main::t045', 0, 1); |
30d9c59b Z |
535 | is eval("t045(0)"), "0/"; |
536 | is eval("t045(456)"), "456/"; | |
537 | is eval("t045(456, 789)"), "456/"; | |
538 | is eval("t045(456, 789, 987)"), undef; | |
0f14f058 | 539 | like $@, _create_flexible_mismatch_regexp('main::t045', 3, 2); |
30d9c59b Z |
540 | is $a, 123; |
541 | ||
542 | sub t046 ($, $b = 333) { "$a/$b" } | |
543 | is prototype(\&t046), undef; | |
544 | is eval("t046()"), undef; | |
0f14f058 | 545 | like $@, _create_flexible_mismatch_regexp('main::t046', 0, 1); |
30d9c59b Z |
546 | is eval("t046(0)"), "123/333"; |
547 | is eval("t046(456)"), "123/333"; | |
548 | is eval("t046(456, 789)"), "123/789"; | |
549 | is eval("t046(456, 789, 987)"), undef; | |
0f14f058 | 550 | like $@, _create_flexible_mismatch_regexp('main::t046', 3, 2); |
30d9c59b Z |
551 | is $a, 123; |
552 | ||
553 | sub t047 ($, $ = 333) { "$a/" } | |
554 | is prototype(\&t047), undef; | |
555 | is eval("t047()"), undef; | |
0f14f058 | 556 | like $@, _create_flexible_mismatch_regexp('main::t047', 0, 1); |
30d9c59b Z |
557 | is eval("t047(0)"), "123/"; |
558 | is eval("t047(456)"), "123/"; | |
559 | is eval("t047(456, 789)"), "123/"; | |
560 | is eval("t047(456, 789, 987)"), undef; | |
0f14f058 | 561 | like $@, _create_flexible_mismatch_regexp('main::t047', 3, 2); |
30d9c59b Z |
562 | is $a, 123; |
563 | ||
564 | sub t029 ($a, $b, $c = 222, $d = 333) { "$a/$b/$c/$d" } | |
565 | is prototype(\&t029), undef; | |
566 | is eval("t029()"), undef; | |
0f14f058 | 567 | like $@, _create_flexible_mismatch_regexp('main::t029', 0, 2); |
30d9c59b | 568 | is eval("t029(0)"), undef; |
0f14f058 | 569 | like $@, _create_flexible_mismatch_regexp('main::t029', 1, 2); |
30d9c59b | 570 | is eval("t029(456)"), undef; |
0f14f058 | 571 | like $@, _create_flexible_mismatch_regexp('main::t029', 1, 2); |
30d9c59b Z |
572 | is eval("t029(456, 789)"), "456/789/222/333"; |
573 | is eval("t029(456, 789, 987)"), "456/789/987/333"; | |
574 | is eval("t029(456, 789, 987, 654)"), "456/789/987/654"; | |
575 | is eval("t029(456, 789, 987, 654, 321)"), undef; | |
0f14f058 | 576 | like $@, _create_flexible_mismatch_regexp('main::t029', 5, 4); |
30d9c59b | 577 | is eval("t029(456, 789, 987, 654, 321, 111)"), undef; |
0f14f058 | 578 | like $@, _create_flexible_mismatch_regexp('main::t029', 6, 4); |
30d9c59b Z |
579 | is $a, 123; |
580 | ||
581 | sub t038 ($a, $b = $a."x") { "$a/$b" } | |
582 | is prototype(\&t038), undef; | |
583 | is eval("t038()"), undef; | |
0f14f058 | 584 | like $@, _create_flexible_mismatch_regexp('main::t038', 0, 1); |
30d9c59b Z |
585 | is eval("t038(0)"), "0/0x"; |
586 | is eval("t038(456)"), "456/456x"; | |
587 | is eval("t038(456, 789)"), "456/789"; | |
588 | is eval("t038(456, 789, 987)"), undef; | |
0f14f058 | 589 | like $@, _create_flexible_mismatch_regexp('main::t038', 3, 2); |
30d9c59b Z |
590 | is $a, 123; |
591 | ||
592 | eval "#line 8 foo\nsub t030 (\$a = 222, \$b) { }"; | |
d3d9da4a | 593 | is $@, qq{Mandatory parameter follows optional parameter at foo line 8, near "\$b) "\n}; |
30d9c59b Z |
594 | |
595 | eval "#line 8 foo\nsub t031 (\$a = 222, \$b = 333, \$c, \$d) { }"; | |
d3d9da4a DM |
596 | is $@, <<EOF; |
597 | Mandatory parameter follows optional parameter at foo line 8, near "\$c," | |
598 | Mandatory parameter follows optional parameter at foo line 8, near "\$d) " | |
599 | EOF | |
30d9c59b | 600 | |
f17d9825 PE |
601 | sub t206 ($x, $y //= 3) { return $x + $y } |
602 | is eval("t206(5,4)"), 9, '//= present'; | |
603 | is eval("t206(5)"), 8, '//= absent'; | |
604 | is eval("t206(4,undef)"), 7, '//= undef'; | |
605 | is eval("t206(4,0)"), 4, '//= zero'; | |
606 | ||
607 | sub t207 ($x, $y ||= 3) { return $x + $y } | |
608 | is eval("t207(5,4)"), 9, '||= present'; | |
609 | is eval("t207(5)"), 8, '||= absent'; | |
610 | is eval("t207(4,undef)"), 7, '||= undef'; | |
611 | is eval("t207(4,0)"), 7, '||= zero'; | |
612 | ||
30d9c59b Z |
613 | sub t034 (@abc) { join("/", @abc).";".scalar(@abc) } |
614 | is prototype(\&t034), undef; | |
615 | is eval("t034()"), ";0"; | |
616 | is eval("t034(0)"), "0;1"; | |
617 | is eval("t034(456)"), "456;1"; | |
618 | is eval("t034(456, 789)"), "456/789;2"; | |
619 | is eval("t034(456, 789, 987)"), "456/789/987;3"; | |
620 | is eval("t034(456, 789, 987, 654)"), "456/789/987/654;4"; | |
621 | is eval("t034(456, 789, 987, 654, 321)"), "456/789/987/654/321;5"; | |
622 | is eval("t034(456, 789, 987, 654, 321, 111)"), "456/789/987/654/321/111;6"; | |
623 | is $a, 123; | |
624 | ||
863e3089 | 625 | eval "#line 8 foo\nsub t136 (\@abc = 222) { }"; |
bb6b75cd | 626 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n}; |
863e3089 Z |
627 | |
628 | eval "#line 8 foo\nsub t137 (\@abc =) { }"; | |
bb6b75cd | 629 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n}; |
863e3089 | 630 | |
30d9c59b Z |
631 | sub t035 (@) { $a } |
632 | is prototype(\&t035), undef; | |
633 | is eval("t035()"), 123; | |
634 | is eval("t035(0)"), 123; | |
635 | is eval("t035(456)"), 123; | |
636 | is eval("t035(456, 789)"), 123; | |
637 | is eval("t035(456, 789, 987)"), 123; | |
638 | is eval("t035(456, 789, 987, 654)"), 123; | |
639 | is eval("t035(456, 789, 987, 654, 321)"), 123; | |
640 | is eval("t035(456, 789, 987, 654, 321, 111)"), 123; | |
641 | is $a, 123; | |
642 | ||
863e3089 | 643 | eval "#line 8 foo\nsub t138 (\@ = 222) { }"; |
bb6b75cd | 644 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n}; |
863e3089 Z |
645 | |
646 | eval "#line 8 foo\nsub t139 (\@ =) { }"; | |
bb6b75cd | 647 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n}; |
863e3089 | 648 | |
30d9c59b Z |
649 | sub t039 (%abc) { join("/", map { $_."=".$abc{$_} } sort keys %abc) } |
650 | is prototype(\&t039), undef; | |
651 | is eval("t039()"), ""; | |
652 | is eval("t039(0)"), undef; | |
ac7609e4 | 653 | like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b | 654 | is eval("t039(456)"), undef; |
ac7609e4 | 655 | like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
656 | is eval("t039(456, 789)"), "456=789"; |
657 | is eval("t039(456, 789, 987)"), undef; | |
ac7609e4 | 658 | like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
659 | is eval("t039(456, 789, 987, 654)"), "456=789/987=654"; |
660 | is eval("t039(456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 661 | like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
662 | is eval("t039(456, 789, 987, 654, 321, 111)"), "321=111/456=789/987=654"; |
663 | is $a, 123; | |
664 | ||
863e3089 | 665 | eval "#line 8 foo\nsub t140 (\%abc = 222) { }"; |
bb6b75cd | 666 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n}; |
863e3089 Z |
667 | |
668 | eval "#line 8 foo\nsub t141 (\%abc =) { }"; | |
bb6b75cd | 669 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n}; |
863e3089 | 670 | |
30d9c59b Z |
671 | sub t040 (%) { $a } |
672 | is prototype(\&t040), undef; | |
673 | is eval("t040()"), 123; | |
674 | is eval("t040(0)"), undef; | |
ac7609e4 | 675 | like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b | 676 | is eval("t040(456)"), undef; |
ac7609e4 | 677 | like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
678 | is eval("t040(456, 789)"), 123; |
679 | is eval("t040(456, 789, 987)"), undef; | |
ac7609e4 | 680 | like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
681 | is eval("t040(456, 789, 987, 654)"), 123; |
682 | is eval("t040(456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 683 | like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
684 | is eval("t040(456, 789, 987, 654, 321, 111)"), 123; |
685 | is $a, 123; | |
686 | ||
863e3089 | 687 | eval "#line 8 foo\nsub t142 (\% = 222) { }"; |
bb6b75cd | 688 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n}; |
863e3089 Z |
689 | |
690 | eval "#line 8 foo\nsub t143 (\% =) { }"; | |
bb6b75cd | 691 | is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n}; |
863e3089 | 692 | |
30d9c59b Z |
693 | sub t041 ($a, @b) { $a.";".join("/", @b) } |
694 | is prototype(\&t041), undef; | |
695 | is eval("t041()"), undef; | |
0f14f058 | 696 | like $@, _create_flexible_mismatch_regexp('main::t041', 0, 1); |
30d9c59b Z |
697 | is eval("t041(0)"), "0;"; |
698 | is eval("t041(456)"), "456;"; | |
699 | is eval("t041(456, 789)"), "456;789"; | |
700 | is eval("t041(456, 789, 987)"), "456;789/987"; | |
701 | is eval("t041(456, 789, 987, 654)"), "456;789/987/654"; | |
702 | is eval("t041(456, 789, 987, 654, 321)"), "456;789/987/654/321"; | |
703 | is eval("t041(456, 789, 987, 654, 321, 111)"), "456;789/987/654/321/111"; | |
704 | is $a, 123; | |
705 | ||
706 | sub t042 ($a, @) { $a.";" } | |
707 | is prototype(\&t042), undef; | |
708 | is eval("t042()"), undef; | |
0f14f058 | 709 | like $@, _create_flexible_mismatch_regexp('main::t042', 0, 1); |
30d9c59b Z |
710 | is eval("t042(0)"), "0;"; |
711 | is eval("t042(456)"), "456;"; | |
712 | is eval("t042(456, 789)"), "456;"; | |
713 | is eval("t042(456, 789, 987)"), "456;"; | |
714 | is eval("t042(456, 789, 987, 654)"), "456;"; | |
715 | is eval("t042(456, 789, 987, 654, 321)"), "456;"; | |
716 | is eval("t042(456, 789, 987, 654, 321, 111)"), "456;"; | |
717 | is $a, 123; | |
718 | ||
719 | sub t043 ($, @b) { $a.";".join("/", @b) } | |
720 | is prototype(\&t043), undef; | |
721 | is eval("t043()"), undef; | |
0f14f058 | 722 | like $@, _create_flexible_mismatch_regexp('main::t043', 0, 1); |
30d9c59b Z |
723 | is eval("t043(0)"), "123;"; |
724 | is eval("t043(456)"), "123;"; | |
725 | is eval("t043(456, 789)"), "123;789"; | |
726 | is eval("t043(456, 789, 987)"), "123;789/987"; | |
727 | is eval("t043(456, 789, 987, 654)"), "123;789/987/654"; | |
728 | is eval("t043(456, 789, 987, 654, 321)"), "123;789/987/654/321"; | |
729 | is eval("t043(456, 789, 987, 654, 321, 111)"), "123;789/987/654/321/111"; | |
730 | is $a, 123; | |
731 | ||
732 | sub t044 ($, @) { $a.";" } | |
733 | is prototype(\&t044), undef; | |
734 | is eval("t044()"), undef; | |
0f14f058 | 735 | like $@, _create_flexible_mismatch_regexp('main::t044', 0, 1); |
30d9c59b Z |
736 | is eval("t044(0)"), "123;"; |
737 | is eval("t044(456)"), "123;"; | |
738 | is eval("t044(456, 789)"), "123;"; | |
739 | is eval("t044(456, 789, 987)"), "123;"; | |
740 | is eval("t044(456, 789, 987, 654)"), "123;"; | |
741 | is eval("t044(456, 789, 987, 654, 321)"), "123;"; | |
742 | is eval("t044(456, 789, 987, 654, 321, 111)"), "123;"; | |
743 | is $a, 123; | |
744 | ||
745 | sub t049 ($a, %b) { $a.";".join("/", map { $_."=".$b{$_} } sort keys %b) } | |
746 | is prototype(\&t049), undef; | |
747 | is eval("t049()"), undef; | |
0f14f058 | 748 | like $@, _create_flexible_mismatch_regexp('main::t049', 0, 1); |
30d9c59b Z |
749 | is eval("t049(222)"), "222;"; |
750 | is eval("t049(222, 456)"), undef; | |
ac7609e4 | 751 | like $@, qr#\AOdd name/value argument for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
752 | is eval("t049(222, 456, 789)"), "222;456=789"; |
753 | is eval("t049(222, 456, 789, 987)"), undef; | |
ac7609e4 | 754 | like $@, qr#\AOdd name/value argument for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
755 | is eval("t049(222, 456, 789, 987, 654)"), "222;456=789/987=654"; |
756 | is eval("t049(222, 456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 757 | like $@, qr#\AOdd name/value argument for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
758 | is eval("t049(222, 456, 789, 987, 654, 321, 111)"), |
759 | "222;321=111/456=789/987=654"; | |
760 | is $a, 123; | |
761 | ||
762 | sub t051 ($a, $b, $c, @d) { "$a;$b;$c;".join("/", @d).";".scalar(@d) } | |
763 | is prototype(\&t051), undef; | |
764 | is eval("t051()"), undef; | |
0f14f058 | 765 | like $@, _create_flexible_mismatch_regexp('main::t051', 0, 3); |
30d9c59b | 766 | is eval("t051(456)"), undef; |
0f14f058 | 767 | like $@, _create_flexible_mismatch_regexp('main::t051', 1, 3); |
30d9c59b | 768 | is eval("t051(456, 789)"), undef; |
0f14f058 | 769 | like $@, _create_flexible_mismatch_regexp('main::t051', 2, 3); |
30d9c59b Z |
770 | is eval("t051(456, 789, 987)"), "456;789;987;;0"; |
771 | is eval("t051(456, 789, 987, 654)"), "456;789;987;654;1"; | |
772 | is eval("t051(456, 789, 987, 654, 321)"), "456;789;987;654/321;2"; | |
773 | is eval("t051(456, 789, 987, 654, 321, 111)"), "456;789;987;654/321/111;3"; | |
774 | is $a, 123; | |
775 | ||
776 | sub t052 ($a, $b, %c) { "$a;$b;".join("/", map { $_."=".$c{$_} } sort keys %c) } | |
777 | is prototype(\&t052), undef; | |
778 | is eval("t052()"), undef; | |
0f14f058 | 779 | like $@, _create_flexible_mismatch_regexp('main::t052', 0, 2); |
30d9c59b | 780 | is eval("t052(222)"), undef; |
0f14f058 | 781 | like $@, _create_flexible_mismatch_regexp('main::t052', 1, 2); |
30d9c59b Z |
782 | is eval("t052(222, 333)"), "222;333;"; |
783 | is eval("t052(222, 333, 456)"), undef; | |
ac7609e4 | 784 | like $@, qr#\AOdd name/value argument for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
785 | is eval("t052(222, 333, 456, 789)"), "222;333;456=789"; |
786 | is eval("t052(222, 333, 456, 789, 987)"), undef; | |
ac7609e4 | 787 | like $@, qr#\AOdd name/value argument for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
788 | is eval("t052(222, 333, 456, 789, 987, 654)"), "222;333;456=789/987=654"; |
789 | is eval("t052(222, 333, 456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 790 | like $@, qr#\AOdd name/value argument for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
791 | is eval("t052(222, 333, 456, 789, 987, 654, 321, 111)"), |
792 | "222;333;321=111/456=789/987=654"; | |
793 | is $a, 123; | |
794 | ||
795 | sub t053 ($a, $b, $c, %d) { | |
796 | "$a;$b;$c;".join("/", map { $_."=".$d{$_} } sort keys %d) | |
797 | } | |
798 | is prototype(\&t053), undef; | |
799 | is eval("t053()"), undef; | |
0f14f058 | 800 | like $@, _create_flexible_mismatch_regexp('main::t053', 0, 3); |
30d9c59b | 801 | is eval("t053(222)"), undef; |
0f14f058 | 802 | like $@, _create_flexible_mismatch_regexp('main::t053', 1, 3); |
30d9c59b | 803 | is eval("t053(222, 333)"), undef; |
0f14f058 | 804 | like $@, _create_flexible_mismatch_regexp('main::t053', 2, 3); |
30d9c59b Z |
805 | is eval("t053(222, 333, 444)"), "222;333;444;"; |
806 | is eval("t053(222, 333, 444, 456)"), undef; | |
ac7609e4 | 807 | like $@, qr#\AOdd name/value argument for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
808 | is eval("t053(222, 333, 444, 456, 789)"), "222;333;444;456=789"; |
809 | is eval("t053(222, 333, 444, 456, 789, 987)"), undef; | |
ac7609e4 | 810 | like $@, qr#\AOdd name/value argument for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
811 | is eval("t053(222, 333, 444, 456, 789, 987, 654)"), |
812 | "222;333;444;456=789/987=654"; | |
813 | is eval("t053(222, 333, 444, 456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 814 | like $@, qr#\AOdd name/value argument for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
815 | is eval("t053(222, 333, 444, 456, 789, 987, 654, 321, 111)"), |
816 | "222;333;444;321=111/456=789/987=654"; | |
817 | is $a, 123; | |
818 | ||
819 | sub t048 ($a = 222, @b) { $a.";".join("/", @b).";".scalar(@b) } | |
820 | is prototype(\&t048), undef; | |
821 | is eval("t048()"), "222;;0"; | |
822 | is eval("t048(0)"), "0;;0"; | |
823 | is eval("t048(456)"), "456;;0"; | |
824 | is eval("t048(456, 789)"), "456;789;1"; | |
825 | is eval("t048(456, 789, 987)"), "456;789/987;2"; | |
826 | is eval("t048(456, 789, 987, 654)"), "456;789/987/654;3"; | |
827 | is eval("t048(456, 789, 987, 654, 321)"), "456;789/987/654/321;4"; | |
828 | is eval("t048(456, 789, 987, 654, 321, 111)"), "456;789/987/654/321/111;5"; | |
829 | is $a, 123; | |
830 | ||
831 | sub t054 ($a = 222, $b = 333, @c) { "$a;$b;".join("/", @c).";".scalar(@c) } | |
832 | is prototype(\&t054), undef; | |
833 | is eval("t054()"), "222;333;;0"; | |
834 | is eval("t054(456)"), "456;333;;0"; | |
835 | is eval("t054(456, 789)"), "456;789;;0"; | |
836 | is eval("t054(456, 789, 987)"), "456;789;987;1"; | |
837 | is eval("t054(456, 789, 987, 654)"), "456;789;987/654;2"; | |
838 | is eval("t054(456, 789, 987, 654, 321)"), "456;789;987/654/321;3"; | |
839 | is eval("t054(456, 789, 987, 654, 321, 111)"), "456;789;987/654/321/111;4"; | |
840 | is $a, 123; | |
841 | ||
842 | sub t055 ($a = 222, $b = 333, $c = 444, @d) { | |
843 | "$a;$b;$c;".join("/", @d).";".scalar(@d) | |
844 | } | |
845 | is prototype(\&t055), undef; | |
846 | is eval("t055()"), "222;333;444;;0"; | |
847 | is eval("t055(456)"), "456;333;444;;0"; | |
848 | is eval("t055(456, 789)"), "456;789;444;;0"; | |
849 | is eval("t055(456, 789, 987)"), "456;789;987;;0"; | |
850 | is eval("t055(456, 789, 987, 654)"), "456;789;987;654;1"; | |
851 | is eval("t055(456, 789, 987, 654, 321)"), "456;789;987;654/321;2"; | |
852 | is eval("t055(456, 789, 987, 654, 321, 111)"), "456;789;987;654/321/111;3"; | |
853 | is $a, 123; | |
854 | ||
855 | sub t050 ($a = 211, %b) { $a.";".join("/", map { $_."=".$b{$_} } sort keys %b) } | |
856 | is prototype(\&t050), undef; | |
857 | is eval("t050()"), "211;"; | |
858 | is eval("t050(222)"), "222;"; | |
859 | is eval("t050(222, 456)"), undef; | |
ac7609e4 | 860 | like $@, qr#\AOdd name/value argument for subroutine 'main::t050' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
861 | is eval("t050(222, 456, 789)"), "222;456=789"; |
862 | is eval("t050(222, 456, 789, 987)"), undef; | |
ac7609e4 | 863 | like $@, qr#\AOdd name/value argument for subroutine 'main::t050' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
864 | is eval("t050(222, 456, 789, 987, 654)"), "222;456=789/987=654"; |
865 | is eval("t050(222, 456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 866 | like $@, qr#\AOdd name/value argument for subroutine 'main::t050' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
867 | is eval("t050(222, 456, 789, 987, 654, 321, 111)"), |
868 | "222;321=111/456=789/987=654"; | |
869 | is $a, 123; | |
870 | ||
871 | sub t056 ($a = 211, $b = 311, %c) { | |
872 | "$a;$b;".join("/", map { $_."=".$c{$_} } sort keys %c) | |
873 | } | |
874 | is prototype(\&t056), undef; | |
875 | is eval("t056()"), "211;311;"; | |
876 | is eval("t056(222)"), "222;311;"; | |
877 | is eval("t056(222, 333)"), "222;333;"; | |
878 | is eval("t056(222, 333, 456)"), undef; | |
ac7609e4 | 879 | like $@, qr#\AOdd name/value argument for subroutine 'main::t056' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
880 | is eval("t056(222, 333, 456, 789)"), "222;333;456=789"; |
881 | is eval("t056(222, 333, 456, 789, 987)"), undef; | |
ac7609e4 | 882 | like $@, qr#\AOdd name/value argument for subroutine 'main::t056' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
883 | is eval("t056(222, 333, 456, 789, 987, 654)"), "222;333;456=789/987=654"; |
884 | is eval("t056(222, 333, 456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 885 | like $@, qr#\AOdd name/value argument for subroutine 'main::t056' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
886 | is eval("t056(222, 333, 456, 789, 987, 654, 321, 111)"), |
887 | "222;333;321=111/456=789/987=654"; | |
888 | is $a, 123; | |
889 | ||
890 | sub t057 ($a = 211, $b = 311, $c = 411, %d) { | |
891 | "$a;$b;$c;".join("/", map { $_."=".$d{$_} } sort keys %d) | |
892 | } | |
893 | is prototype(\&t057), undef; | |
894 | is eval("t057()"), "211;311;411;"; | |
895 | is eval("t057(222)"), "222;311;411;"; | |
896 | is eval("t057(222, 333)"), "222;333;411;"; | |
897 | is eval("t057(222, 333, 444)"), "222;333;444;"; | |
898 | is eval("t057(222, 333, 444, 456)"), undef; | |
ac7609e4 | 899 | like $@, qr#\AOdd name/value argument for subroutine 'main::t057' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
900 | is eval("t057(222, 333, 444, 456, 789)"), "222;333;444;456=789"; |
901 | is eval("t057(222, 333, 444, 456, 789, 987)"), undef; | |
ac7609e4 | 902 | like $@, qr#\AOdd name/value argument for subroutine 'main::t057' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
903 | is eval("t057(222, 333, 444, 456, 789, 987, 654)"), |
904 | "222;333;444;456=789/987=654"; | |
905 | is eval("t057(222, 333, 444, 456, 789, 987, 654, 321)"), undef; | |
ac7609e4 | 906 | like $@, qr#\AOdd name/value argument for subroutine 'main::t057' at \(eval \d+\) line 1\.\n\z#; |
30d9c59b Z |
907 | is eval("t057(222, 333, 444, 456, 789, 987, 654, 321, 111)"), |
908 | "222;333;444;321=111/456=789/987=654"; | |
909 | is $a, 123; | |
910 | ||
911 | sub t058 ($a, $b = 333, @c) { "$a;$b;".join("/", @c).";".scalar(@c) } | |
912 | is prototype(\&t058), undef; | |
913 | is eval("t058()"), undef; | |
0f14f058 | 914 | like $@, _create_flexible_mismatch_regexp('main::t058', 0, 1); |
30d9c59b Z |
915 | is eval("t058(456)"), "456;333;;0"; |
916 | is eval("t058(456, 789)"), "456;789;;0"; | |
917 | is eval("t058(456, 789, 987)"), "456;789;987;1"; | |
918 | is eval("t058(456, 789, 987, 654)"), "456;789;987/654;2"; | |
919 | is eval("t058(456, 789, 987, 654, 321)"), "456;789;987/654/321;3"; | |
920 | is eval("t058(456, 789, 987, 654, 321, 111)"), "456;789;987/654/321/111;4"; | |
921 | is $a, 123; | |
922 | ||
923 | eval "#line 8 foo\nsub t059 (\@a, \$b) { }"; | |
d3d9da4a | 924 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n}; |
30d9c59b Z |
925 | |
926 | eval "#line 8 foo\nsub t060 (\@a, \$b = 222) { }"; | |
d3d9da4a | 927 | is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n}; |
30d9c59b Z |
928 | |
929 | eval "#line 8 foo\nsub t061 (\@a, \@b) { }"; | |
d3d9da4a | 930 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@b) "\n}; |
30d9c59b Z |
931 | |
932 | eval "#line 8 foo\nsub t062 (\@a, \%b) { }"; | |
d3d9da4a | 933 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "%b) "\n}; |
30d9c59b Z |
934 | |
935 | eval "#line 8 foo\nsub t063 (\@, \$b) { }"; | |
d3d9da4a | 936 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n}; |
30d9c59b Z |
937 | |
938 | eval "#line 8 foo\nsub t064 (\@, \$b = 222) { }"; | |
d3d9da4a | 939 | is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n}; |
30d9c59b Z |
940 | |
941 | eval "#line 8 foo\nsub t065 (\@, \@b) { }"; | |
d3d9da4a | 942 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@b) "\n}; |
30d9c59b Z |
943 | |
944 | eval "#line 8 foo\nsub t066 (\@, \%b) { }"; | |
d3d9da4a | 945 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "%b) "\n}; |
30d9c59b Z |
946 | |
947 | eval "#line 8 foo\nsub t067 (\@a, \$) { }"; | |
d3d9da4a | 948 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$) "\n}; |
30d9c59b Z |
949 | |
950 | eval "#line 8 foo\nsub t068 (\@a, \$ = 222) { }"; | |
d3d9da4a | 951 | is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n}; |
30d9c59b Z |
952 | |
953 | eval "#line 8 foo\nsub t069 (\@a, \@) { }"; | |
d3d9da4a | 954 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@) "\n}; |
30d9c59b Z |
955 | |
956 | eval "#line 8 foo\nsub t070 (\@a, \%) { }"; | |
d3d9da4a | 957 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\%) "\n}; |
30d9c59b Z |
958 | |
959 | eval "#line 8 foo\nsub t071 (\@, \$) { }"; | |
d3d9da4a | 960 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$) "\n}; |
30d9c59b Z |
961 | |
962 | eval "#line 8 foo\nsub t072 (\@, \$ = 222) { }"; | |
d3d9da4a | 963 | is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n}; |
30d9c59b Z |
964 | |
965 | eval "#line 8 foo\nsub t073 (\@, \@) { }"; | |
d3d9da4a | 966 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@) "\n}; |
30d9c59b Z |
967 | |
968 | eval "#line 8 foo\nsub t074 (\@, \%) { }"; | |
d3d9da4a | 969 | is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\%) "\n}; |
30d9c59b Z |
970 | |
971 | eval "#line 8 foo\nsub t075 (\%a, \$b) { }"; | |
d3d9da4a | 972 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n}; |
30d9c59b Z |
973 | |
974 | eval "#line 8 foo\nsub t076 (\%, \$b) { }"; | |
d3d9da4a | 975 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n}; |
30d9c59b Z |
976 | |
977 | eval "#line 8 foo\nsub t077 (\$a, \@b, \$c) { }"; | |
d3d9da4a | 978 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$c) "\n}; |
30d9c59b Z |
979 | |
980 | eval "#line 8 foo\nsub t078 (\$a, \%b, \$c) { }"; | |
d3d9da4a | 981 | is $@, qq{Slurpy parameter not last at foo line 8, near "\$c) "\n}; |
30d9c59b Z |
982 | |
983 | eval "#line 8 foo\nsub t079 (\$a, \@b, \$c, \$d) { }"; | |
d3d9da4a DM |
984 | is $@, <<EOF; |
985 | Slurpy parameter not last at foo line 8, near "\$c," | |
986 | Slurpy parameter not last at foo line 8, near "\$d) " | |
987 | EOF | |
30d9c59b Z |
988 | |
989 | sub t080 ($a,,, $b) { $a.$b } | |
990 | is prototype(\&t080), undef; | |
991 | is eval("t080()"), undef; | |
0f14f058 | 992 | like $@, _create_mismatch_regexp('main::t080', 0, 2); |
30d9c59b | 993 | is eval("t080(456)"), undef; |
0f14f058 | 994 | like $@, _create_mismatch_regexp('main::t080', 1, 2); |
30d9c59b Z |
995 | is eval("t080(456, 789)"), "456789"; |
996 | is eval("t080(456, 789, 987)"), undef; | |
0f14f058 | 997 | like $@, _create_mismatch_regexp('main::t080', 3, 2); |
30d9c59b | 998 | is eval("t080(456, 789, 987, 654)"), undef; |
0f14f058 | 999 | like $@, _create_mismatch_regexp('main::t080', 4, 2); |
30d9c59b Z |
1000 | is $a, 123; |
1001 | ||
1002 | sub t081 ($a, $b,,) { $a.$b } | |
1003 | is prototype(\&t081), undef; | |
1004 | is eval("t081()"), undef; | |
0f14f058 | 1005 | like $@, _create_mismatch_regexp('main::t081', 0, 2); |
30d9c59b | 1006 | is eval("t081(456)"), undef; |
0f14f058 | 1007 | like $@, _create_mismatch_regexp('main::t081', 1, 2); |
30d9c59b Z |
1008 | is eval("t081(456, 789)"), "456789"; |
1009 | is eval("t081(456, 789, 987)"), undef; | |
0f14f058 | 1010 | like $@, _create_mismatch_regexp('main::t081', 3, 2); |
30d9c59b | 1011 | is eval("t081(456, 789, 987, 654)"), undef; |
0f14f058 | 1012 | like $@, _create_mismatch_regexp('main::t081', 4, 2); |
30d9c59b Z |
1013 | is $a, 123; |
1014 | ||
1015 | eval "#line 8 foo\nsub t082 (, \$a) { }"; | |
d3d9da4a | 1016 | is $@, qq{syntax error at foo line 8, near "(,"\n}; |
30d9c59b Z |
1017 | |
1018 | eval "#line 8 foo\nsub t083 (,) { }"; | |
d3d9da4a | 1019 | is $@, qq{syntax error at foo line 8, near "(,"\n}; |
30d9c59b Z |
1020 | |
1021 | sub t084($a,$b){ $a.$b } | |
1022 | is prototype(\&t084), undef; | |
1023 | is eval("t084()"), undef; | |
0f14f058 | 1024 | like $@, _create_mismatch_regexp('main::t084', 0, 2); |
30d9c59b | 1025 | is eval("t084(456)"), undef; |
0f14f058 | 1026 | like $@, _create_mismatch_regexp('main::t084', 1, 2); |
30d9c59b Z |
1027 | is eval("t084(456, 789)"), "456789"; |
1028 | is eval("t084(456, 789, 987)"), undef; | |
0f14f058 | 1029 | like $@, _create_mismatch_regexp('main::t084', 3, 2); |
30d9c59b | 1030 | is eval("t084(456, 789, 987, 654)"), undef; |
0f14f058 | 1031 | like $@, _create_mismatch_regexp('main::t084', 4, 2); |
30d9c59b Z |
1032 | is $a, 123; |
1033 | ||
1034 | sub t085 | |
1035 | ( | |
1036 | $ | |
1037 | a | |
1038 | , | |
1039 | , | |
1040 | $ | |
1041 | b | |
1042 | = | |
1043 | 333 | |
1044 | , | |
1045 | , | |
1046 | ) | |
1047 | { $a.$b } | |
1048 | is prototype(\&t085), undef; | |
1049 | is eval("t085()"), undef; | |
0f14f058 | 1050 | like $@, _create_flexible_mismatch_regexp('main::t085', 0, 1); |
30d9c59b Z |
1051 | is eval("t085(456)"), "456333"; |
1052 | is eval("t085(456, 789)"), "456789"; | |
1053 | is eval("t085(456, 789, 987)"), undef; | |
0f14f058 | 1054 | like $@, _create_flexible_mismatch_regexp('main::t085', 3, 2); |
30d9c59b | 1055 | is eval("t085(456, 789, 987, 654)"), undef; |
0f14f058 | 1056 | like $@, _create_flexible_mismatch_regexp('main::t085', 4, 2); |
30d9c59b Z |
1057 | is $a, 123; |
1058 | ||
1059 | sub t086 | |
1060 | ( #foo))) | |
1061 | $ #foo))) | |
1062 | a #foo))) | |
1063 | , #foo))) | |
1064 | , #foo))) | |
1065 | $ #foo))) | |
1066 | b #foo))) | |
1067 | = #foo))) | |
1068 | 333 #foo))) | |
1069 | , #foo))) | |
1070 | , #foo))) | |
1071 | ) #foo))) | |
1072 | { $a.$b } | |
1073 | is prototype(\&t086), undef; | |
1074 | is eval("t086()"), undef; | |
0f14f058 | 1075 | like $@, _create_flexible_mismatch_regexp('main::t086', 0, 1); |
30d9c59b Z |
1076 | is eval("t086(456)"), "456333"; |
1077 | is eval("t086(456, 789)"), "456789"; | |
1078 | is eval("t086(456, 789, 987)"), undef; | |
0f14f058 | 1079 | like $@, _create_flexible_mismatch_regexp('main::t086', 3, 2); |
30d9c59b | 1080 | is eval("t086(456, 789, 987, 654)"), undef; |
0f14f058 | 1081 | like $@, _create_flexible_mismatch_regexp('main::t086', 4, 2); |
30d9c59b Z |
1082 | is $a, 123; |
1083 | ||
1084 | sub t087 | |
1085 | (#foo))) | |
1086 | $ #foo))) | |
1087 | a#foo))) | |
1088 | ,#foo))) | |
1089 | ,#foo))) | |
1090 | $ #foo))) | |
1091 | b#foo))) | |
1092 | =#foo))) | |
1093 | 333#foo))) | |
1094 | ,#foo))) | |
1095 | ,#foo))) | |
1096 | )#foo))) | |
1097 | { $a.$b } | |
1098 | is prototype(\&t087), undef; | |
1099 | is eval("t087()"), undef; | |
0f14f058 | 1100 | like $@, _create_flexible_mismatch_regexp('main::t087', 0, 1); |
30d9c59b Z |
1101 | is eval("t087(456)"), "456333"; |
1102 | is eval("t087(456, 789)"), "456789"; | |
1103 | is eval("t087(456, 789, 987)"), undef; | |
0f14f058 | 1104 | like $@, _create_flexible_mismatch_regexp('main::t087', 3, 2); |
30d9c59b | 1105 | is eval("t087(456, 789, 987, 654)"), undef; |
0f14f058 | 1106 | like $@, _create_flexible_mismatch_regexp('main::t087', 4, 2); |
30d9c59b Z |
1107 | is $a, 123; |
1108 | ||
1109 | eval "#line 8 foo\nsub t088 (\$ #foo\na) { }"; | |
1110 | is $@, ""; | |
1111 | ||
d3d9da4a | 1112 | |
30d9c59b | 1113 | eval "#line 8 foo\nsub t089 (\$#foo\na) { }"; |
d3d9da4a | 1114 | like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(\$"\n}; |
30d9c59b Z |
1115 | |
1116 | eval "#line 8 foo\nsub t090 (\@ #foo\na) { }"; | |
1117 | is $@, ""; | |
1118 | ||
1119 | eval "#line 8 foo\nsub t091 (\@#foo\na) { }"; | |
d3d9da4a | 1120 | like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(\@"\n}; |
30d9c59b Z |
1121 | |
1122 | eval "#line 8 foo\nsub t092 (\% #foo\na) { }"; | |
1123 | is $@, ""; | |
1124 | ||
1125 | eval "#line 8 foo\nsub t093 (\%#foo\na) { }"; | |
d3d9da4a | 1126 | like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(%"\n}; |
30d9c59b Z |
1127 | |
1128 | eval "#line 8 foo\nsub t094 (123) { }"; | |
bb6b75cd | 1129 | like $@, qr{\AA signature parameter must start with '\$', '\@' or '%' at foo line 8, near "\(1"\n}; |
30d9c59b Z |
1130 | |
1131 | eval "#line 8 foo\nsub t095 (\$a, 123) { }"; | |
d3d9da4a | 1132 | is $@, <<EOF; |
bb6b75cd | 1133 | A signature parameter must start with '\$', '\@' or '%' at foo line 8, near ", 1" |
d3d9da4a DM |
1134 | syntax error at foo line 8, near ", 123" |
1135 | EOF | |
30d9c59b | 1136 | |
71986b33 | 1137 | eval "#line 8 foo\nno warnings; sub t096 (\$a 123) { }"; |
08ccc810 TC |
1138 | is $@, <<'EOF'; |
1139 | Illegal operator following parameter in a subroutine signature at foo line 8, near "($a 123" | |
1140 | syntax error at foo line 8, near "($a 123" | |
1141 | EOF | |
30d9c59b Z |
1142 | |
1143 | eval "#line 8 foo\nsub t097 (\$a { }) { }"; | |
08ccc810 TC |
1144 | is $@, <<'EOF'; |
1145 | Illegal operator following parameter in a subroutine signature at foo line 8, near "($a { }" | |
1146 | syntax error at foo line 8, near "($a { }" | |
d3d9da4a | 1147 | EOF |
30d9c59b Z |
1148 | |
1149 | eval "#line 8 foo\nsub t098 (\$a; \$b) { }"; | |
08ccc810 TC |
1150 | is $@, <<'EOF'; |
1151 | Illegal operator following parameter in a subroutine signature at foo line 8, near "($a; " | |
1152 | syntax error at foo line 8, near "($a; " | |
d3d9da4a | 1153 | EOF |
30d9c59b Z |
1154 | |
1155 | eval "#line 8 foo\nsub t099 (\$\$) { }"; | |
d3d9da4a | 1156 | is $@, <<EOF; |
bb6b75cd | 1157 | Illegal character following sigil in a subroutine signature at foo line 8, near "(\$" |
49fb8620 | 1158 | syntax error at foo line 8, near "\$\$) " |
d3d9da4a | 1159 | EOF |
30d9c59b | 1160 | |
30d9c59b | 1161 | eval "#line 8 foo\nsub t101 (\@_) { }"; |
f27832e7 | 1162 | like $@, qr/\ACan't use global \@_ in subroutine signature at foo line 8/; |
30d9c59b Z |
1163 | |
1164 | eval "#line 8 foo\nsub t102 (\%_) { }"; | |
f27832e7 | 1165 | like $@, qr/\ACan't use global \%_ in subroutine signature at foo line 8/; |
30d9c59b Z |
1166 | |
1167 | my $t103 = sub ($a) { $a || "z" }; | |
1168 | is prototype($t103), undef; | |
1169 | is eval("\$t103->()"), undef; | |
0f14f058 | 1170 | like $@, _create_mismatch_regexp('main::__ANON__', 0, 1); |
30d9c59b Z |
1171 | is eval("\$t103->(0)"), "z"; |
1172 | is eval("\$t103->(456)"), 456; | |
1173 | is eval("\$t103->(456, 789)"), undef; | |
0f14f058 | 1174 | like $@, _create_mismatch_regexp('main::__ANON__', 2, 1); |
30d9c59b | 1175 | is eval("\$t103->(456, 789, 987)"), undef; |
0f14f058 | 1176 | like $@, _create_mismatch_regexp('main::__ANON__', 3, 1); |
30d9c59b Z |
1177 | is $a, 123; |
1178 | ||
894f226e | 1179 | my $t118 = sub :prototype($) ($a) { $a || "z" }; |
30d9c59b Z |
1180 | is prototype($t118), "\$"; |
1181 | is eval("\$t118->()"), undef; | |
0f14f058 | 1182 | like $@, _create_mismatch_regexp('main::__ANON__', 0, 1); |
30d9c59b Z |
1183 | is eval("\$t118->(0)"), "z"; |
1184 | is eval("\$t118->(456)"), 456; | |
1185 | is eval("\$t118->(456, 789)"), undef; | |
0f14f058 | 1186 | like $@, _create_mismatch_regexp('main::__ANON__', 2, 1); |
30d9c59b | 1187 | is eval("\$t118->(456, 789, 987)"), undef; |
0f14f058 | 1188 | like $@, _create_mismatch_regexp('main::__ANON__', 3, 1); |
30d9c59b Z |
1189 | is $a, 123; |
1190 | ||
1191 | sub t033 ($a = sub ($a) { $a."z" }) { $a->("a")."y" } | |
1192 | is prototype(\&t033), undef; | |
1193 | is eval("t033()"), "azy"; | |
1194 | is eval("t033(sub { \"x\".\$_[0].\"x\" })"), "xaxy"; | |
1195 | is eval("t033(sub { \"x\".\$_[0].\"x\" }, 789)"), undef; | |
0f14f058 | 1196 | like $@, _create_flexible_mismatch_regexp('main::t033', 2, 1); |
30d9c59b Z |
1197 | is $a, 123; |
1198 | ||
863e3089 Z |
1199 | sub t133 ($a = sub ($a = 222) { $a."z" }) { $a->()."/".$a->("a") } |
1200 | is prototype(\&t133), undef; | |
1201 | is eval("t133()"), "222z/az"; | |
1202 | is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" })"), "xux/xax"; | |
1203 | is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" }, 789)"), undef; | |
0f14f058 | 1204 | like $@, _create_flexible_mismatch_regexp('main::t133', 2, 1); |
863e3089 Z |
1205 | is $a, 123; |
1206 | ||
1207 | sub t134 ($a = sub ($a, $t = sub { $_[0]."p" }) { $t->($a)."z" }) { | |
1208 | $a->("a")."/".$a->("b", sub { $_[0]."q" } ) | |
1209 | } | |
1210 | is prototype(\&t134), undef; | |
1211 | is eval("t134()"), "apz/bqz"; | |
1212 | is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), | |
1213 | "xax/xbqx"; | |
1214 | is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), | |
1215 | undef; | |
0f14f058 | 1216 | like $@, _create_flexible_mismatch_regexp('main::t134', 2, 1); |
863e3089 Z |
1217 | is $a, 123; |
1218 | ||
1219 | sub t135 ($a = sub ($a, $t = sub ($p) { $p."p" }) { $t->($a)."z" }) { | |
1220 | $a->("a")."/".$a->("b", sub { $_[0]."q" } ) | |
1221 | } | |
1222 | is prototype(\&t135), undef; | |
1223 | is eval("t135()"), "apz/bqz"; | |
1224 | is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), | |
1225 | "xax/xbqx"; | |
1226 | is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), | |
1227 | undef; | |
0f14f058 | 1228 | like $@, _create_flexible_mismatch_regexp('main::t135', 2, 1); |
863e3089 Z |
1229 | is $a, 123; |
1230 | ||
1231 | sub t132 ( | |
1232 | $a = sub ($a, $t = sub ($p = 222) { $p."p" }) { $t->($a)."z".$t->() }, | |
1233 | ) { | |
1234 | $a->("a")."/".$a->("b", sub { ($_[0] // "u")."q" } ) | |
1235 | } | |
1236 | is prototype(\&t132), undef; | |
1237 | is eval("t132()"), "apz222p/bqzuq"; | |
1238 | is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), | |
1239 | "xax/xbqx"; | |
1240 | is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), | |
1241 | undef; | |
0f14f058 | 1242 | like $@, _create_flexible_mismatch_regexp('main::t132', 2, 1); |
863e3089 Z |
1243 | is $a, 123; |
1244 | ||
894f226e | 1245 | sub t104 :method ($a) { $a || "z" } |
30d9c59b Z |
1246 | is prototype(\&t104), undef; |
1247 | is eval("t104()"), undef; | |
0f14f058 | 1248 | like $@, _create_mismatch_regexp('main::t104', 0, 1); |
30d9c59b Z |
1249 | is eval("t104(0)"), "z"; |
1250 | is eval("t104(456)"), 456; | |
1251 | is eval("t104(456, 789)"), undef; | |
0f14f058 | 1252 | like $@, _create_mismatch_regexp('main::t104', 2, 1); |
30d9c59b | 1253 | is eval("t104(456, 789, 987)"), undef; |
0f14f058 | 1254 | like $@, _create_mismatch_regexp('main::t104', 3, 1); |
30d9c59b Z |
1255 | is $a, 123; |
1256 | ||
894f226e | 1257 | sub t105 :prototype($) ($a) { $a || "z" } |
30d9c59b Z |
1258 | is prototype(\&t105), "\$"; |
1259 | is eval("t105()"), undef; | |
1260 | like $@, qr/\ANot enough arguments for main::t105 /; | |
1261 | is eval("t105(0)"), "z"; | |
1262 | is eval("t105(456)"), 456; | |
1263 | is eval("t105(456, 789)"), undef; | |
aff539aa | 1264 | like $@, qr/\AToo many arguments for main::t105 at \(eval \d+\) line 1, near/; |
30d9c59b | 1265 | is eval("t105(456, 789, 987)"), undef; |
aff539aa | 1266 | like $@, qr/\AToo many arguments for main::t105 at \(eval \d+\) line 1, near/; |
30d9c59b Z |
1267 | is $a, 123; |
1268 | ||
894f226e | 1269 | sub t106 :prototype(@) ($a) { $a || "z" } |
30d9c59b Z |
1270 | is prototype(\&t106), "\@"; |
1271 | is eval("t106()"), undef; | |
0f14f058 | 1272 | like $@, _create_mismatch_regexp('main::t106', 0, 1); |
30d9c59b Z |
1273 | is eval("t106(0)"), "z"; |
1274 | is eval("t106(456)"), 456; | |
1275 | is eval("t106(456, 789)"), undef; | |
0f14f058 | 1276 | like $@, _create_mismatch_regexp('main::t106', 2, 1); |
30d9c59b | 1277 | is eval("t106(456, 789, 987)"), undef; |
0f14f058 | 1278 | like $@, _create_mismatch_regexp('main::t106', 3, 1); |
30d9c59b Z |
1279 | is $a, 123; |
1280 | ||
894f226e | 1281 | eval "#line 8 foo\nsub t107(\$a) :method { }"; |
30d9c59b Z |
1282 | isnt $@, ""; |
1283 | ||
894f226e | 1284 | eval "#line 8 foo\nsub t108 (\$a) :prototype(\$) { }"; |
30d9c59b Z |
1285 | isnt $@, ""; |
1286 | ||
1287 | sub t109 { } | |
1288 | is prototype(\&t109), undef; | |
1289 | is scalar(@{[ t109() ]}), 0; | |
1290 | is scalar(t109()), undef; | |
1291 | ||
1292 | sub t110 () { } | |
1293 | is prototype(\&t110), undef; | |
1294 | is scalar(@{[ t110() ]}), 0; | |
1295 | is scalar(t110()), undef; | |
1296 | ||
1297 | sub t111 ($a) { } | |
1298 | is prototype(\&t111), undef; | |
1299 | is scalar(@{[ t111(222) ]}), 0; | |
1300 | is scalar(t111(222)), undef; | |
1301 | ||
1302 | sub t112 ($) { } | |
1303 | is prototype(\&t112), undef; | |
1304 | is scalar(@{[ t112(222) ]}), 0; | |
1305 | is scalar(t112(222)), undef; | |
1306 | ||
1307 | sub t114 ($a = undef) { } | |
1308 | is prototype(\&t114), undef; | |
1309 | is scalar(@{[ t114() ]}), 0; | |
1310 | is scalar(t114()), undef; | |
1311 | is scalar(@{[ t114(333) ]}), 0; | |
1312 | is scalar(t114(333)), undef; | |
1313 | ||
1314 | sub t113 ($a = 222) { } | |
1315 | is prototype(\&t113), undef; | |
1316 | is scalar(@{[ t113() ]}), 0; | |
1317 | is scalar(t113()), undef; | |
1318 | is scalar(@{[ t113(333) ]}), 0; | |
1319 | is scalar(t113(333)), undef; | |
1320 | ||
1321 | sub t115 ($a = do { $z++; 222 }) { } | |
1322 | is prototype(\&t115), undef; | |
1323 | $z = 0; | |
1324 | is scalar(@{[ t115() ]}), 0; | |
1325 | is $z, 1; | |
1326 | is scalar(t115()), undef; | |
1327 | is $z, 2; | |
1328 | is scalar(@{[ t115(333) ]}), 0; | |
1329 | is scalar(t115(333)), undef; | |
1330 | is $z, 2; | |
1331 | ||
1332 | sub t116 (@a) { } | |
1333 | is prototype(\&t116), undef; | |
1334 | is scalar(@{[ t116() ]}), 0; | |
1335 | is scalar(t116()), undef; | |
1336 | is scalar(@{[ t116(333) ]}), 0; | |
1337 | is scalar(t116(333)), undef; | |
1338 | ||
1339 | sub t117 (%a) { } | |
1340 | is prototype(\&t117), undef; | |
1341 | is scalar(@{[ t117() ]}), 0; | |
1342 | is scalar(t117()), undef; | |
1343 | is scalar(@{[ t117(333, 444) ]}), 0; | |
1344 | is scalar(t117(333, 444)), undef; | |
1345 | ||
4fa06845 DM |
1346 | sub t145 ($=3) { } |
1347 | is scalar(t145()), undef; | |
1348 | ||
1349 | { | |
1350 | my $want; | |
1351 | sub want { $want = wantarray ? "list" | |
1352 | : defined(wantarray) ? "scalar" : "void"; 1 } | |
1353 | ||
1354 | sub t144 ($a = want()) { $a } | |
1355 | t144(); | |
1356 | is ($want, "scalar", "default expression is scalar in void context"); | |
1357 | my $x = t144(); | |
1358 | is ($want, "scalar", "default expression is scalar in scalar context"); | |
1359 | () = t144(); | |
1360 | is ($want, "scalar", "default expression is scalar in list context"); | |
1361 | } | |
1362 | ||
f6ca42c7 DM |
1363 | |
1364 | # check for default arg code doing nasty things (closures, gotos, | |
1365 | # modifying @_ etc). | |
1366 | ||
1367 | { | |
1368 | no warnings qw(closure); | |
1369 | use Tie::Array; | |
1370 | use Tie::Hash; | |
1371 | ||
1372 | sub t146 ($a = t146x()) { | |
1373 | sub t146x { $a = "abc"; 1 } | |
1374 | $a; | |
1375 | } | |
1376 | is t146(), 1, "t146: closure can make new lexical not undef"; | |
1377 | ||
1378 | sub t147 ($a = t147x()) { | |
1379 | sub t147x { $a = "abc"; pos($a)=1; 1 } | |
1380 | is pos($a), undef, "t147: pos magic cleared"; | |
1381 | $a; | |
1382 | } | |
1383 | is t147(), 1, "t147: closure can make new lexical not undef and magical"; | |
1384 | ||
1385 | sub t148 ($a = t148x()) { | |
1386 | sub t148x { $a = []; 1 } | |
1387 | $a; | |
1388 | } | |
1389 | is t148(), 1, "t148: closure can make new lexical a ref"; | |
1390 | ||
1391 | sub t149 ($a = t149x()) { | |
1392 | sub t149x { $a = 1; [] } | |
1393 | $a; | |
1394 | } | |
1395 | is ref(t149()), "ARRAY", "t149: closure can make new lexical a ref"; | |
1396 | ||
40151a41 PE |
1397 | # Quiet the 'use of @_ is experimental' warnings |
1398 | no warnings 'experimental::args_array_with_signatures'; | |
1399 | ||
f6ca42c7 DM |
1400 | sub t150 ($a = do {@_ = qw(a b c); 1}, $b = 2) { |
1401 | is $a, 1, "t150: a: growing \@_"; | |
1402 | is $b, "b", "t150: b: growing \@_"; | |
1403 | } | |
1404 | t150(); | |
1405 | ||
f6ca42c7 DM |
1406 | sub t151 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, $b = 2) { |
1407 | is $a, 1, "t151: a: tied \@_"; | |
1408 | is $b, "b", "t151: b: tied \@_"; | |
1409 | } | |
1410 | t151(); | |
1411 | ||
1412 | sub t152 ($a = t152x(), @b) { | |
1413 | sub t152x { @b = qw(a b c); 1 } | |
1414 | $a . '-' . join(':', @b); | |
1415 | } | |
1416 | is t152(), "1-", "t152: closure can make new lexical array non-empty"; | |
1417 | ||
1418 | sub t153 ($a = t153x(), %b) { | |
1419 | sub t153x { %b = qw(a 10 b 20); 1 } | |
1420 | $a . '-' . join(':', sort %b); | |
1421 | } | |
1422 | is t153(), "1-", "t153: closure can make new lexical hash non-empty"; | |
1423 | ||
1424 | sub t154 ($a = t154x(), @b) { | |
1425 | sub t154x { tie @b, 'Tie::StdArray'; @b = qw(a b c); 1 } | |
1426 | $a . '-' . join(':', @b); | |
1427 | } | |
1428 | is t154(), "1-", "t154: closure can make new lexical array tied"; | |
1429 | ||
1430 | sub t155 ($a = t155x(), %b) { | |
1431 | sub t155x { tie %b, 'Tie::StdHash'; %b = qw(a 10 b 20); 1 } | |
1432 | $a . '-' . join(':', sort %b); | |
1433 | } | |
1434 | is t155(), "1-", "t155: closure can make new lexical hash tied"; | |
1435 | ||
1436 | sub t156 ($a = do {@_ = qw(a b c); 1}, @b) { | |
1437 | is $a, 1, "t156: a: growing \@_"; | |
1438 | is "@b", "b c", "t156: b: growing \@_"; | |
1439 | } | |
1440 | t156(); | |
1441 | ||
1442 | sub t157 ($a = do {@_ = qw(a b c); 1}, %b) { | |
1443 | is $a, 1, "t157: a: growing \@_"; | |
1444 | is join(':', sort %b), "b:c", "t157: b: growing \@_"; | |
1445 | } | |
1446 | t157(); | |
1447 | ||
1448 | sub t158 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, @b) { | |
1449 | is $a, 1, "t158: a: tied \@_"; | |
1450 | is "@b", "b c", "t158: b: tied \@_"; | |
1451 | } | |
1452 | t158(); | |
1453 | ||
1454 | sub t159 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, %b) { | |
1455 | is $a, 1, "t159: a: tied \@_"; | |
1456 | is join(':', sort %b), "b:c", "t159: b: tied \@_"; | |
1457 | } | |
1458 | t159(); | |
1459 | ||
1460 | # see if we can handle the equivalent of @a = ($a[1], $a[0]) | |
1461 | ||
1462 | sub t160 ($s, @a) { | |
1463 | sub t160x { | |
1464 | @a = qw(x y); | |
1465 | t160(1, $a[1], $a[0]); | |
1466 | } | |
1467 | # encourage recently-freed SVPVs to be realloced with new values | |
1468 | my @pad = qw(a b); | |
1469 | join ':', $s, @a; | |
1470 | } | |
1471 | is t160x(), "1:y:x", 'handle commonality in slurpy array'; | |
1472 | ||
1473 | # see if we can handle the equivalent of %h = ('foo', $h{foo}) | |
1474 | ||
1475 | sub t161 ($s, %h) { | |
1476 | sub t161x { | |
1477 | %h = qw(k1 v1 k2 v2); | |
1478 | t161(1, k1 => $h{k2}, k2 => $h{k1}); | |
1479 | } | |
1480 | # encourage recently-freed SVPVs to be realloced with new values | |
1481 | my @pad = qw(a b); | |
1482 | join ' ', $s, map "($_,$h{$_})", sort keys %h; | |
1483 | } | |
1484 | is t161x(), "1 (k1,v2) (k2,v1)", 'handle commonality in slurpy hash'; | |
1485 | ||
1486 | # see if we can handle the equivalent of ($a,$b) = ($b,$a) | |
1487 | # Note that for non-signatured subs, my ($a,$b) = @_ already fails the | |
1488 | # equivalent of this test too, since I skipped pessimising it | |
1489 | # (90ce4d057857) as commonality in this case is rare and contrived, | |
1490 | # as the example below shows. DAPM. | |
1491 | sub t162 ($a, $b) { | |
1492 | sub t162x { | |
1493 | ($a, $b) = qw(x y); | |
1494 | t162($b, $a); | |
1495 | } | |
1496 | "$a:$b"; | |
1497 | } | |
1498 | { | |
71986b33 | 1499 | local $::TODO = q{can't handle commonaility}; |
f6ca42c7 DM |
1500 | is t162x(), "y:x", 'handle commonality in scalar parms'; |
1501 | } | |
f6ca42c7 DM |
1502 | } |
1503 | ||
d79f31b5 DM |
1504 | { |
1505 | my $w; | |
d79f31b5 DM |
1506 | local $SIG{__WARN__} = sub { $w .= "@_" }; |
1507 | is eval q{sub ($x,$x) { $x}->(1,2)}, 2, "duplicate sig var names"; | |
1508 | like $w, qr/^"my" variable \$x masks earlier declaration in same scope/, | |
1509 | "masking warning"; | |
1510 | } | |
1511 | ||
ac7609e4 AC |
1512 | # Reporting subroutine names |
1513 | ||
1514 | package T200 { | |
1515 | sub foo ($x) {} | |
1516 | *t201 = sub ($x) {} | |
1517 | } | |
1518 | *t202 = sub ($x) {}; | |
1519 | my $t203 = sub ($x) {}; | |
1520 | *t204 = *T200::foo; | |
1521 | *t205 = \&T200::foo; | |
1522 | ||
1523 | eval { T200::foo() }; | |
1524 | like($@, qr/^Too few arguments for subroutine 'T200::foo'/); | |
1525 | eval { T200::t201() }; | |
1526 | like($@, qr/^Too few arguments for subroutine 'T200::__ANON__'/); | |
1527 | eval { t202() }; | |
1528 | like($@, qr/^Too few arguments for subroutine 'main::__ANON__'/); | |
1529 | eval { $t203->() }; | |
1530 | like($@, qr/^Too few arguments for subroutine 'main::__ANON__'/); | |
1531 | eval { t204() }; | |
1532 | like($@, qr/^Too few arguments for subroutine 'T200::foo'/); | |
1533 | eval { t205() }; | |
1534 | like($@, qr/^Too few arguments for subroutine 'T200::foo'/); | |
1535 | ||
1536 | ||
cbf40e71 DM |
1537 | # RT #130661 a char >= 0x80 in a signature when a sigil was expected |
1538 | # was triggering an assertion | |
1539 | ||
1540 | eval "sub (\x80"; | |
1541 | like $@, qr/A signature parameter must start with/, "RT #130661"; | |
1542 | ||
f6ca42c7 DM |
1543 | |
1544 | ||
1ccc3f31 FC |
1545 | use File::Spec::Functions; |
1546 | my $keywords_file = catfile(updir,'regen','keywords.pl'); | |
1547 | open my $kh, $keywords_file | |
1548 | or die "$0 cannot open $keywords_file: $!"; | |
1549 | while(<$kh>) { | |
1550 | if (m?__END__?..${\0} and /^[+-]/) { | |
1551 | chomp(my $word = $'); | |
1552 | # $y should be an error after $x=foo. The exact error we get may | |
1553 | # differ if this is __END__ or s or some other special keyword. | |
71986b33 | 1554 | eval 'no warnings; sub ($x = ' . $word . ', $y) {}'; |
1ccc3f31 FC |
1555 | isnt $@, "", "$word does not swallow trailing comma"; |
1556 | } | |
1557 | } | |
1558 | ||
894f226e DM |
1559 | # RT #132141 |
1560 | # Attributes such as lvalue have to come *before* the signature to | |
1561 | # ensure that they're applied to any code block within the signature | |
1562 | ||
1563 | { | |
1564 | my $x; | |
1565 | sub f :lvalue ($a = do { $x = "abc"; return substr($x,0,1)}) { | |
1566 | die; # notreached | |
1567 | } | |
1568 | ||
1569 | f() = "X"; | |
1570 | is $x, "Xbc", "RT #132141"; | |
1571 | } | |
1572 | ||
a8c56356 DM |
1573 | # RT #132760 |
1574 | # attributes have been moved back before signatures for 5.28. Ensure that | |
1575 | # code doing it the old wrong way get a meaningful error message. | |
1576 | ||
1577 | { | |
1578 | my @errs; | |
1579 | local $SIG{__WARN__} = sub { push @errs, @_}; | |
1580 | eval q{ | |
1581 | sub rt132760 ($a, $b) :prototype($$) { $a + $b } | |
1582 | }; | |
1583 | ||
1584 | @errs = split /\n/, $@; | |
1585 | is +@errs, 1, "RT 132760 expect 1 error"; | |
1586 | like $errs[0], | |
1587 | qr/^Subroutine attributes must come before the signature at/, | |
1588 | "RT 132760 err 0"; | |
1589 | } | |
894f226e | 1590 | |
558b227c DM |
1591 | # check that warnings come from the correct line |
1592 | ||
1593 | { | |
1594 | my @warn; | |
1595 | local $SIG{__WARN__} = sub { push @warn, @_}; | |
1596 | eval q{ | |
1597 | sub multiline1 ( | |
1598 | $a, | |
1599 | $b = $a + 1, | |
1600 | $c = $a + 1) | |
1601 | { | |
1602 | my $d = $a + 1; | |
1603 | my $e = $a + 1; | |
1604 | } | |
1605 | }; | |
1606 | multiline1(undef); | |
1607 | like $warn[0], qr/line 4,/, 'multiline1: $b'; | |
1608 | like $warn[1], qr/line 5,/, 'multiline1: $c'; | |
1609 | like $warn[2], qr/line 7,/, 'multiline1: $d'; | |
1610 | like $warn[3], qr/line 8,/, 'multiline1: $e'; | |
1611 | } | |
1612 | ||
f27832e7 DM |
1613 | # check errors for using global vars as params |
1614 | ||
1615 | { | |
1616 | eval q{ sub ($_) {} }; | |
1617 | like $@, qr/Can't use global \$_ in subroutine signature/, 'f($_)'; | |
1618 | eval q{ sub (@_) {} }; | |
1619 | like $@, qr/Can't use global \@_ in subroutine signature/, 'f(@_)'; | |
1620 | eval q{ sub (%_) {} }; | |
1621 | like $@, qr/Can't use global \%_ in subroutine signature/, 'f(%_)'; | |
1622 | eval q{ sub ($1) {} }; | |
1623 | like $@, qr/Illegal operator following parameter in a subroutine signature/, | |
1624 | 'f($1)'; | |
1625 | } | |
558b227c | 1626 | |
40151a41 PE |
1627 | # check that various uses of @_ inside signatured subs causes "experimental" |
1628 | # warnings at compiletime | |
1629 | { | |
1630 | sub warnings_from { | |
1631 | my ($code, $run) = @_; | |
1632 | my $warnings = ""; | |
1633 | local $SIG{__WARN__} = sub { $warnings .= join "", @_ }; | |
1634 | my $cv = eval qq{ sub(\$x) { $code }} or die "Cannot eval() - $@"; | |
1635 | $run and $cv->(123); | |
1636 | return $warnings; | |
1637 | } | |
1638 | ||
1639 | sub snailwarns_ok { | |
1640 | my ($opname, $code) = @_; | |
1641 | my $warnings = warnings_from $code; | |
1642 | ok($warnings =~ m/[Uu]se of \@_ in $opname with signatured subroutine is experimental at \(eval /, | |
1643 | "`$code` warns of experimental \@_") or | |
1644 | diag("Warnings were:\n$warnings"); | |
1645 | } | |
1646 | ||
1647 | sub snailwarns_runtime_ok { | |
1648 | my ($opname, $code) = @_; | |
1649 | my $warnings = warnings_from $code, 1; | |
1650 | ok($warnings =~ m/[Uu]se of \@_ in $opname with signatured subroutine is experimental at \(eval /, | |
1651 | "`$code` warns of experimental \@_") or | |
1652 | diag("Warnings were:\n$warnings"); | |
1653 | } | |
1654 | ||
1655 | sub not_snailwarns_ok { | |
1656 | my ($code) = @_; | |
1657 | my $warnings = warnings_from $code; | |
1658 | ok($warnings !~ m/[Uu]se of \@_ in .* with signatured subroutine is experimental at \(eval /, | |
1659 | "`$code` warns of experimental \@_") or | |
1660 | diag("Warnings were:\n$warnings"); | |
1661 | } | |
1662 | ||
1663 | # implicit @_ | |
1664 | snailwarns_ok 'shift', 'shift'; | |
1665 | snailwarns_ok 'pop', 'pop'; | |
1666 | snailwarns_ok 'goto', 'goto &SUB'; # tail-call | |
1667 | snailwarns_ok 'subroutine entry', '&SUB'; # perl4-style | |
1668 | ||
1669 | # explicit @_ | |
1670 | snailwarns_ok 'shift', 'shift @_'; | |
1671 | snailwarns_ok 'pop', 'pop @_'; | |
1672 | snailwarns_ok 'array element', '$_[0]'; | |
1673 | snailwarns_ok 'array element', 'my $one = 1; $_[$one]'; | |
1674 | snailwarns_ok 'push', 'push @_, 1'; | |
1675 | snailwarns_ok 'unshift', 'unshift @_, 9'; | |
1676 | snailwarns_ok 'splice', 'splice @_, 1, 2, 3'; | |
1677 | snailwarns_ok 'keys on array', 'keys @_'; | |
1678 | snailwarns_ok 'values on array', 'values @_'; | |
1679 | snailwarns_ok 'each on array', 'each @_'; | |
1680 | snailwarns_ok 'print', 'print "a", @_, "z"'; | |
1681 | snailwarns_ok 'subroutine entry', 'func("a", @_, "z")'; | |
1682 | ||
1683 | # Also warns about @_ inside the signature params | |
1684 | like(warnings_from('sub ($x = shift) { }'), | |
1685 | qr/^Implicit use of \@_ in shift with signatured subroutine is experimental at \(eval /, | |
1686 | 'Warns of experimental @_ in param default'); | |
1687 | like(warnings_from('sub ($x = $_[0]) { }'), | |
1688 | qr/^Use of \@_ in array element with signatured subroutine is experimental at \(eval /, | |
1689 | 'Warns of experimental @_ in param default'); | |
1690 | ||
1691 | # Inside eval() still counts, at runtime | |
1692 | snailwarns_runtime_ok 'array element', 'eval q( $_[0] )'; | |
1693 | ||
1694 | # still permitted without warning | |
1695 | not_snailwarns_ok 'my $f = sub { my $y = shift; }'; | |
1696 | not_snailwarns_ok 'my $f = sub { my $y = $_[0]; }'; | |
1697 | not_snailwarns_ok '\&SUB'; | |
1698 | } | |
1699 | ||
1700 | # Warnings can be disabled | |
1701 | { | |
1702 | my $warnings = ""; | |
1703 | local $SIG{__WARN__} = sub { $warnings .= join "", @_ }; | |
1704 | eval q{ | |
1705 | no warnings 'experimental::snail_in_signatures'; | |
1706 | sub($x) { @_ = (1,2,3) } | |
1707 | }; | |
1708 | is($warnings, "", 'No warnings emitted within scope of no warnings "experimental"'); | |
1709 | } | |
1710 | ||
1ccc3f31 FC |
1711 | done_testing; |
1712 | ||
30d9c59b | 1713 | 1; |