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