1#!perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7}
8
9use warnings;
10use strict;
11
12our $a = 123;
13our $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
23eval "#line 8 foo\nsub t004 :method (\$a) { }";
24like $@, qr{syntax error at foo line 8}, "error when not enabled 1";
25
26eval "#line 8 foo\nsub t005 (\$) (\$a) { }";
27like $@, qr{syntax error at foo line 8}, "error when not enabled 2";
28
29
30no warnings "experimental::signatures";
31use feature "signatures";
32
33sub t001 { $a || "z" }
34is prototype(\&t001), undef;
35is eval("t001()"), 123;
36is eval("t001(456)"), 123;
37is eval("t001(456, 789)"), 123;
38is $a, 123;
39
40sub t002 () { $a || "z" }
41is prototype(\&t002), undef;
42is eval("t002()"), 123;
43is eval("t002(456)"), undef;
44like $@, qr/\AToo many arguments for subroutine 'main::t002' at \(eval \d+\) line 1\.\n\z/;
45is eval("t002(456, 789)"), undef;
46like $@, qr/\AToo many arguments for subroutine 'main::t002' at \(eval \d+\) line 1\.\n\z/;
47is $a, 123;
48
49sub t003 ( ) { $a || "z" }
50is prototype(\&t003), undef;
51is eval("t003()"), 123;
52is eval("t003(456)"), undef;
53like $@, qr/\AToo many arguments for subroutine 'main::t003' at \(eval \d+\) line 1\.\n\z/;
54is eval("t003(456, 789)"), undef;
55like $@, qr/\AToo many arguments for subroutine 'main::t003' at \(eval \d+\) line 1\.\n\z/;
56is $a, 123;
57
58sub t006 ($a) { $a || "z" }
59is prototype(\&t006), undef;
60is eval("t006()"), undef;
61like $@, qr/\AToo few arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/;
62is eval("t006(0)"), "z";
63is eval("t006(456)"), 456;
64is eval("t006(456, 789)"), undef;
65like $@, qr/\AToo many arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/;
66is eval("t006(456, 789, 987)"), undef;
67like $@, qr/\AToo many arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/;
68is $a, 123;
69
70sub t007 ($a, $b) { $a.$b }
71is prototype(\&t007), undef;
72is eval("t007()"), undef;
73like $@, qr/\AToo few arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/;
74is eval("t007(456)"), undef;
75like $@, qr/\AToo few arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/;
76is eval("t007(456, 789)"), "456789";
77is eval("t007(456, 789, 987)"), undef;
78like $@, qr/\AToo many arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/;
79is eval("t007(456, 789, 987, 654)"), undef;
80like $@, qr/\AToo many arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/;
81is $a, 123;
82
83sub t008 ($a, $b, $c) { $a.$b.$c }
84is prototype(\&t008), undef;
85is eval("t008()"), undef;
86like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/;
87is eval("t008(456)"), undef;
88like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/;
89is eval("t008(456, 789)"), undef;
90like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/;
91is eval("t008(456, 789, 987)"), "456789987";
92is eval("t008(456, 789, 987, 654)"), undef;
93like $@, qr/\AToo many arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/;
94is $a, 123;
95
96sub t009 ($abc, $def) { $abc.$def }
97is prototype(\&t009), undef;
98is eval("t009()"), undef;
99like $@, qr/\AToo few arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/;
100is eval("t009(456)"), undef;
101like $@, qr/\AToo few arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/;
102is eval("t009(456, 789)"), "456789";
103is eval("t009(456, 789, 987)"), undef;
104like $@, qr/\AToo many arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/;
105is eval("t009(456, 789, 987, 654)"), undef;
106like $@, qr/\AToo many arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/;
107is $a, 123;
108
109sub t010 ($a, $) { $a || "z" }
110is prototype(\&t010), undef;
111is eval("t010()"), undef;
112like $@, qr/\AToo few arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/;
113is eval("t010(456)"), undef;
114like $@, qr/\AToo few arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/;
115is eval("t010(0, 789)"), "z";
116is eval("t010(456, 789)"), 456;
117is eval("t010(456, 789, 987)"), undef;
118like $@, qr/\AToo many arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/;
119is eval("t010(456, 789, 987, 654)"), undef;
120like $@, qr/\AToo many arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/;
121is $a, 123;
122
123sub t011 ($, $a) { $a || "z" }
124is prototype(\&t011), undef;
125is eval("t011()"), undef;
126like $@, qr/\AToo few arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/;
127is eval("t011(456)"), undef;
128like $@, qr/\AToo few arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/;
129is eval("t011(456, 0)"), "z";
130is eval("t011(456, 789)"), 789;
131is eval("t011(456, 789, 987)"), undef;
132like $@, qr/\AToo many arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/;
133is eval("t011(456, 789, 987, 654)"), undef;
134like $@, qr/\AToo many arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/;
135is $a, 123;
136
137sub t012 ($, $) { $a || "z" }
138is prototype(\&t012), undef;
139is eval("t012()"), undef;
140like $@, qr/\AToo few arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/;
141is eval("t012(456)"), undef;
142like $@, qr/\AToo few arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/;
143is eval("t012(0, 789)"), 123;
144is eval("t012(456, 789)"), 123;
145is eval("t012(456, 789, 987)"), undef;
146like $@, qr/\AToo many arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/;
147is eval("t012(456, 789, 987, 654)"), undef;
148like $@, qr/\AToo many arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/;
149is $a, 123;
150
151sub t013 ($) { $a || "z" }
152is prototype(\&t013), undef;
153is eval("t013()"), undef;
154like $@, qr/\AToo few arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/;
155is eval("t013(0)"), 123;
156is eval("t013(456)"), 123;
157is eval("t013(456, 789)"), undef;
158like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/;
159is eval("t013(456, 789, 987)"), undef;
160like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/;
161is eval("t013(456, 789, 987, 654)"), undef;
162like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/;
163is $a, 123;
164
165sub t014 ($a = 222) { $a // "z" }
166is prototype(\&t014), undef;
167is eval("t014()"), 222;
168is eval("t014(0)"), 0;
169is eval("t014(undef)"), "z";
170is eval("t014(456)"), 456;
171is eval("t014(456, 789)"), undef;
172like $@, qr/\AToo many arguments for subroutine 'main::t014' at \(eval \d+\) line 1\.\n\z/;
173is eval("t014(456, 789, 987)"), undef;
174like $@, qr/\AToo many arguments for subroutine 'main::t014' at \(eval \d+\) line 1\.\n\z/;
175is $a, 123;
176
177sub t015 ($a = undef) { $a // "z" }
178is prototype(\&t015), undef;
179is eval("t015()"), "z";
180is eval("t015(0)"), 0;
181is eval("t015(undef)"), "z";
182is eval("t015(456)"), 456;
183is eval("t015(456, 789)"), undef;
184like $@, qr/\AToo many arguments for subroutine 'main::t015' at \(eval \d+\) line 1\.\n\z/;
185is eval("t015(456, 789, 987)"), undef;
186like $@, qr/\AToo many arguments for subroutine 'main::t015' at \(eval \d+\) line 1\.\n\z/;
187is $a, 123;
188
189sub t016 ($a = do { $z++; 222 }) { $a // "z" }
190$z = 0;
191is prototype(\&t016), undef;
192is eval("t016()"), 222;
193is $z, 1;
194is eval("t016(0)"), 0;
195is eval("t016(undef)"), "z";
196is eval("t016(456)"), 456;
197is eval("t016(456, 789)"), undef;
198like $@, qr/\AToo many arguments for subroutine 'main::t016' at \(eval \d+\) line 1\.\n\z/;
199is eval("t016(456, 789, 987)"), undef;
200like $@, qr/\AToo many arguments for subroutine 'main::t016' at \(eval \d+\) line 1\.\n\z/;
201is $z, 1;
202is eval("t016()"), 222;
203is $z, 2;
204is $a, 123;
205
206sub t018 { join("/", @_) }
207sub t017 ($p = t018 222, $a = 333) { $p // "z" }
208is prototype(\&t017), undef;
209is eval("t017()"), "222/333";
210is $a, 333;
211$a = 123;
212is eval("t017(0)"), 0;
213is eval("t017(undef)"), "z";
214is eval("t017(456)"), 456;
215is eval("t017(456, 789)"), undef;
216like $@, qr/\AToo many arguments for subroutine 'main::t017' at \(eval \d+\) line 1\.\n\z/;
217is eval("t017(456, 789, 987)"), undef;
218like $@, qr/\AToo many arguments for subroutine 'main::t017' at \(eval \d+\) line 1\.\n\z/;
219is $a, 123;
220
221sub t019 ($p = 222, $a = 333) { "$p/$a" }
222is prototype(\&t019), undef;
223is eval("t019()"), "222/333";
224is eval("t019(0)"), "0/333";
225is eval("t019(456)"), "456/333";
226is eval("t019(456, 789)"), "456/789";
227is eval("t019(456, 789, 987)"), undef;
228like $@, qr/\AToo many arguments for subroutine 'main::t019' at \(eval \d+\) line 1\.\n\z/;
229is $a, 123;
230
231sub t020 :prototype($) { $_[0]."z" }
232sub t021 ($p = t020 222, $a = 333) { "$p/$a" }
233is prototype(\&t021), undef;
234is eval("t021()"), "222z/333";
235is eval("t021(0)"), "0/333";
236is eval("t021(456)"), "456/333";
237is eval("t021(456, 789)"), "456/789";
238is eval("t021(456, 789, 987)"), undef;
239like $@, qr/\AToo many arguments for subroutine 'main::t021' at \(eval \d+\) line 1\.\n\z/;
240is $a, 123;
241
242sub t022 ($p = do { $z += 10; 222 }, $a = do { $z++; 333 }) { "$p/$a" }
243$z = 0;
244is prototype(\&t022), undef;
245is eval("t022()"), "222/333";
246is $z, 11;
247is eval("t022(0)"), "0/333";
248is $z, 12;
249is eval("t022(456)"), "456/333";
250is $z, 13;
251is eval("t022(456, 789)"), "456/789";
252is eval("t022(456, 789, 987)"), undef;
253like $@, qr/\AToo many arguments for subroutine 'main::t022' at \(eval \d+\) line 1\.\n\z/;
254is $z, 13;
255is $a, 123;
256
257sub t023 ($a = sub { $_[0]."z" }) { $a->("a")."y" }
258is prototype(\&t023), undef;
259is eval("t023()"), "azy";
260is eval("t023(sub { \"x\".\$_[0].\"x\" })"), "xaxy";
261is eval("t023(sub { \"x\".\$_[0].\"x\" }, 789)"), undef;
262like $@, qr/\AToo many arguments for subroutine 'main::t023' at \(eval \d+\) line 1\.\n\z/;
263is $a, 123;
264
265sub t036 ($a = $a."x") { $a."y" }
266is prototype(\&t036), undef;
267is eval("t036()"), "123xy";
268is eval("t036(0)"), "0y";
269is eval("t036(456)"), "456y";
270is eval("t036(456, 789)"), undef;
271like $@, qr/\AToo many arguments for subroutine 'main::t036' at \(eval \d+\) line 1\.\n\z/;
272is $a, 123;
273
274sub t120 ($a = $_) { $a // "z" }
275is prototype(\&t120), undef;
276$_ = "___";
277is eval("t120()"), "___";
278$_ = "___";
279is eval("t120(undef)"), "z";
280$_ = "___";
281is eval("t120(0)"), 0;
282$_ = "___";
283is eval("t120(456)"), 456;
284$_ = "___";
285is eval("t120(456, 789)"), undef;
286like $@, qr/\AToo many arguments for subroutine 'main::t120' at \(eval \d+\) line 1\.\n\z/;
287is $a, 123;
288
289sub t121 ($a = caller) { $a // "z" }
290is prototype(\&t121), undef;
291is eval("t121()"), "main";
292is eval("t121(undef)"), "z";
293is eval("t121(0)"), 0;
294is eval("t121(456)"), 456;
295is eval("t121(456, 789)"), undef;
296like $@, qr/\AToo many arguments for subroutine 'main::t121' at \(eval \d+\) line 1\.\n\z/;
297is eval("package T121::Z; ::t121()"), "T121::Z";
298is eval("package T121::Z; ::t121(undef)"), "z";
299is eval("package T121::Z; ::t121(0)"), 0;
300is eval("package T121::Z; ::t121(456)"), 456;
301is eval("package T121::Z; ::t121(456, 789)"), undef;
302like $@, qr/\AToo many arguments for subroutine 'main::t121' at \(eval \d+\) line 1\.\n\z/;
303is $a, 123;
304
305sub t129 ($a = return 222) { $a."x" }
306is prototype(\&t129), undef;
307is eval("t129()"), "222";
308is eval("t129(0)"), "0x";
309is eval("t129(456)"), "456x";
310is eval("t129(456, 789)"), undef;
311like $@, qr/\AToo many arguments for subroutine 'main::t129' at \(eval \d+\) line 1\.\n\z/;
312is $a, 123;
313
314use feature "current_sub";
315sub t122 ($c = 5, $r = $c > 0 ? __SUB__->($c - 1) : "") { $c.$r }
316is prototype(\&t122), undef;
317is eval("t122()"), "543210";
318is eval("t122(0)"), "0";
319is eval("t122(1)"), "10";
320is eval("t122(5)"), "543210";
321is eval("t122(5, 789)"), "5789";
322is eval("t122(5, 789, 987)"), undef;
323like $@, qr/\AToo many arguments for subroutine 'main::t122' at \(eval \d+\) line 1\.\n\z/;
324is $a, 123;
325
326sub t123 ($list = wantarray) { $list ? "list" : "scalar" }
327is prototype(\&t123), undef;
328is eval("scalar(t123())"), "scalar";
329is eval("(t123())[0]"), "list";
330is eval("scalar(t123(0))"), "scalar";
331is eval("(t123(0))[0]"), "scalar";
332is eval("scalar(t123(1))"), "list";
333is eval("(t123(1))[0]"), "list";
334is eval("t123(456, 789)"), undef;
335like $@, qr/\AToo many arguments for subroutine 'main::t123' at \(eval \d+\) line 1\.\n\z/;
336is $a, 123;
337
338sub t124 ($b = (local $a = $a + 1)) { "$a/$b" }
339is prototype(\&t124), undef;
340is eval("t124()"), "124/124";
341is $a, 123;
342is eval("t124(456)"), "123/456";
343is $a, 123;
344is eval("t124(456, 789)"), undef;
345like $@, qr/\AToo many arguments for subroutine 'main::t124' at \(eval \d+\) line 1\.\n\z/;
346is $a, 123;
347
348sub t125 ($c = (our $t125_counter)++) { $c }
349is prototype(\&t125), undef;
350is eval("t125()"), 0;
351is eval("t125()"), 1;
352is eval("t125()"), 2;
353is eval("t125(456)"), 456;
354is eval("t125(789)"), 789;
355is eval("t125()"), 3;
356is eval("t125()"), 4;
357is eval("t125(456, 789)"), undef;
358like $@, qr/\AToo many arguments for subroutine 'main::t125' at \(eval \d+\) line 1\.\n\z/;
359is $a, 123;
360
361use feature "state";
362sub t126 ($c = (state $s = $z++)) { $c }
363is prototype(\&t126), undef;
364$z = 222;
365is eval("t126(456)"), 456;
366is $z, 222;
367is eval("t126()"), 222;
368is $z, 223;
369is eval("t126(456)"), 456;
370is $z, 223;
371is eval("t126()"), 222;
372is $z, 223;
373is eval("t126(456, 789)"), undef;
374like $@, qr/\AToo many arguments for subroutine 'main::t126' at \(eval \d+\) line 1\.\n\z/;
375is $z, 223;
376is $a, 123;
377
378sub t127 ($c = do { state $s = $z++; $s++ }) { $c }
379is prototype(\&t127), undef;
380$z = 222;
381is eval("t127(456)"), 456;
382is $z, 222;
383is eval("t127()"), 222;
384is $z, 223;
385is eval("t127()"), 223;
386is eval("t127()"), 224;
387is $z, 223;
388is eval("t127(456)"), 456;
389is eval("t127(789)"), 789;
390is eval("t127()"), 225;
391is eval("t127()"), 226;
392is eval("t127(456, 789)"), undef;
393like $@, qr/\AToo many arguments for subroutine 'main::t127' at \(eval \d+\) line 1\.\n\z/;
394is $z, 223;
395is $a, 123;
396
397sub t037 ($a = 222, $b = $a."x") { "$a/$b" }
398is prototype(\&t037), undef;
399is eval("t037()"), "222/222x";
400is eval("t037(0)"), "0/0x";
401is eval("t037(456)"), "456/456x";
402is eval("t037(456, 789)"), "456/789";
403is eval("t037(456, 789, 987)"), undef;
404like $@, qr/\AToo many arguments for subroutine 'main::t037' at \(eval \d+\) line 1\.\n\z/;
405is $a, 123;
406
407sub t128 ($a = 222, $b = ($a = 333)) { "$a/$b" }
408is prototype(\&t128), undef;
409is eval("t128()"), "333/333";
410is eval("t128(0)"), "333/333";
411is eval("t128(456)"), "333/333";
412is eval("t128(456, 789)"), "456/789";
413is eval("t128(456, 789, 987)"), undef;
414like $@, qr/\AToo many arguments for subroutine 'main::t128' at \(eval \d+\) line 1\.\n\z/;
415is $a, 123;
416
417sub t130 { join(",", @_).";".scalar(@_) }
418sub t131 ($a = 222, $b = goto &t130) { "$a/$b" }
419is prototype(\&t131), undef;
420is eval("t131()"), ";0";
421is eval("t131(0)"), "0;1";
422is eval("t131(456)"), "456;1";
423is eval("t131(456, 789)"), "456/789";
424is eval("t131(456, 789, 987)"), undef;
425like $@, qr/\AToo many arguments for subroutine 'main::t131' at \(eval \d+\) line 1\.\n\z/;
426is $a, 123;
427
428eval "#line 8 foo\nsub t024 (\$a =) { }";
429is $@,
430    qq{Optional parameter lacks default expression at foo line 8, near "=) "\n};
431
432sub t025 ($ = undef) { $a // "z" }
433is prototype(\&t025), undef;
434is eval("t025()"), 123;
435is eval("t025(0)"), 123;
436is eval("t025(456)"), 123;
437is eval("t025(456, 789)"), undef;
438like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/;
439is eval("t025(456, 789, 987)"), undef;
440like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/;
441is eval("t025(456, 789, 987, 654)"), undef;
442like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/;
443is $a, 123;
444
445sub t026 ($ = 222) { $a // "z" }
446is prototype(\&t026), undef;
447is eval("t026()"), 123;
448is eval("t026(0)"), 123;
449is eval("t026(456)"), 123;
450is eval("t026(456, 789)"), undef;
451like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/;
452is eval("t026(456, 789, 987)"), undef;
453like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/;
454is eval("t026(456, 789, 987, 654)"), undef;
455like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/;
456is $a, 123;
457
458sub t032 ($ = do { $z++; 222 }) { $a // "z" }
459$z = 0;
460is prototype(\&t032), undef;
461is eval("t032()"), 123;
462is $z, 1;
463is eval("t032(0)"), 123;
464is eval("t032(456)"), 123;
465is eval("t032(456, 789)"), undef;
466like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/;
467is eval("t032(456, 789, 987)"), undef;
468like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/;
469is eval("t032(456, 789, 987, 654)"), undef;
470like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/;
471is $z, 1;
472is $a, 123;
473
474sub t027 ($ =) { $a // "z" }
475is prototype(\&t027), undef;
476is eval("t027()"), 123;
477is eval("t027(0)"), 123;
478is eval("t027(456)"), 123;
479is eval("t027(456, 789)"), undef;
480like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/;
481is eval("t027(456, 789, 987)"), undef;
482like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/;
483is eval("t027(456, 789, 987, 654)"), undef;
484like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/;
485is $a, 123;
486
487sub t119 ($ =, $a = 333) { $a // "z" }
488is prototype(\&t119), undef;
489is eval("t119()"), 333;
490is eval("t119(0)"), 333;
491is eval("t119(456)"), 333;
492is eval("t119(456, 789)"), 789;
493is eval("t119(456, 789, 987)"), undef;
494like $@, qr/\AToo many arguments for subroutine 'main::t119' at \(eval \d+\) line 1\.\n\z/;
495is eval("t119(456, 789, 987, 654)"), undef;
496like $@, qr/\AToo many arguments for subroutine 'main::t119' at \(eval \d+\) line 1\.\n\z/;
497is $a, 123;
498
499sub t028 ($a, $b = 333) { "$a/$b" }
500is prototype(\&t028), undef;
501is eval("t028()"), undef;
502like $@, qr/\AToo few arguments for subroutine 'main::t028' at \(eval \d+\) line 1\.\n\z/;
503is eval("t028(0)"), "0/333";
504is eval("t028(456)"), "456/333";
505is eval("t028(456, 789)"), "456/789";
506is eval("t028(456, 789, 987)"), undef;
507like $@, qr/\AToo many arguments for subroutine 'main::t028' at \(eval \d+\) line 1\.\n\z/;
508is $a, 123;
509
510sub t045 ($a, $ = 333) { "$a/" }
511is prototype(\&t045), undef;
512is eval("t045()"), undef;
513like $@, qr/\AToo few arguments for subroutine 'main::t045' at \(eval \d+\) line 1\.\n\z/;
514is eval("t045(0)"), "0/";
515is eval("t045(456)"), "456/";
516is eval("t045(456, 789)"), "456/";
517is eval("t045(456, 789, 987)"), undef;
518like $@, qr/\AToo many arguments for subroutine 'main::t045' at \(eval \d+\) line 1\.\n\z/;
519is $a, 123;
520
521sub t046 ($, $b = 333) { "$a/$b" }
522is prototype(\&t046), undef;
523is eval("t046()"), undef;
524like $@, qr/\AToo few arguments for subroutine 'main::t046' at \(eval \d+\) line 1\.\n\z/;
525is eval("t046(0)"), "123/333";
526is eval("t046(456)"), "123/333";
527is eval("t046(456, 789)"), "123/789";
528is eval("t046(456, 789, 987)"), undef;
529like $@, qr/\AToo many arguments for subroutine 'main::t046' at \(eval \d+\) line 1\.\n\z/;
530is $a, 123;
531
532sub t047 ($, $ = 333) { "$a/" }
533is prototype(\&t047), undef;
534is eval("t047()"), undef;
535like $@, qr/\AToo few arguments for subroutine 'main::t047' at \(eval \d+\) line 1\.\n\z/;
536is eval("t047(0)"), "123/";
537is eval("t047(456)"), "123/";
538is eval("t047(456, 789)"), "123/";
539is eval("t047(456, 789, 987)"), undef;
540like $@, qr/\AToo many arguments for subroutine 'main::t047' at \(eval \d+\) line 1\.\n\z/;
541is $a, 123;
542
543sub t029 ($a, $b, $c = 222, $d = 333) { "$a/$b/$c/$d" }
544is prototype(\&t029), undef;
545is eval("t029()"), undef;
546like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/;
547is eval("t029(0)"), undef;
548like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/;
549is eval("t029(456)"), undef;
550like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/;
551is eval("t029(456, 789)"), "456/789/222/333";
552is eval("t029(456, 789, 987)"), "456/789/987/333";
553is eval("t029(456, 789, 987, 654)"), "456/789/987/654";
554is eval("t029(456, 789, 987, 654, 321)"), undef;
555like $@, qr/\AToo many arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/;
556is eval("t029(456, 789, 987, 654, 321, 111)"), undef;
557like $@, qr/\AToo many arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/;
558is $a, 123;
559
560sub t038 ($a, $b = $a."x") { "$a/$b" }
561is prototype(\&t038), undef;
562is eval("t038()"), undef;
563like $@, qr/\AToo few arguments for subroutine 'main::t038' at \(eval \d+\) line 1\.\n\z/;
564is eval("t038(0)"), "0/0x";
565is eval("t038(456)"), "456/456x";
566is eval("t038(456, 789)"), "456/789";
567is eval("t038(456, 789, 987)"), undef;
568like $@, qr/\AToo many arguments for subroutine 'main::t038' at \(eval \d+\) line 1\.\n\z/;
569is $a, 123;
570
571eval "#line 8 foo\nsub t030 (\$a = 222, \$b) { }";
572is $@, qq{Mandatory parameter follows optional parameter at foo line 8, near "\$b) "\n};
573
574eval "#line 8 foo\nsub t031 (\$a = 222, \$b = 333, \$c, \$d) { }";
575is $@, <<EOF;
576Mandatory parameter follows optional parameter at foo line 8, near "\$c,"
577Mandatory parameter follows optional parameter at foo line 8, near "\$d) "
578EOF
579
580sub t034 (@abc) { join("/", @abc).";".scalar(@abc) }
581is prototype(\&t034), undef;
582is eval("t034()"), ";0";
583is eval("t034(0)"), "0;1";
584is eval("t034(456)"), "456;1";
585is eval("t034(456, 789)"), "456/789;2";
586is eval("t034(456, 789, 987)"), "456/789/987;3";
587is eval("t034(456, 789, 987, 654)"), "456/789/987/654;4";
588is eval("t034(456, 789, 987, 654, 321)"), "456/789/987/654/321;5";
589is eval("t034(456, 789, 987, 654, 321, 111)"), "456/789/987/654/321/111;6";
590is $a, 123;
591
592eval "#line 8 foo\nsub t136 (\@abc = 222) { }";
593is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
594
595eval "#line 8 foo\nsub t137 (\@abc =) { }";
596is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
597
598sub t035 (@) { $a }
599is prototype(\&t035), undef;
600is eval("t035()"), 123;
601is eval("t035(0)"), 123;
602is eval("t035(456)"), 123;
603is eval("t035(456, 789)"), 123;
604is eval("t035(456, 789, 987)"), 123;
605is eval("t035(456, 789, 987, 654)"), 123;
606is eval("t035(456, 789, 987, 654, 321)"), 123;
607is eval("t035(456, 789, 987, 654, 321, 111)"), 123;
608is $a, 123;
609
610eval "#line 8 foo\nsub t138 (\@ = 222) { }";
611is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
612
613eval "#line 8 foo\nsub t139 (\@ =) { }";
614is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
615
616sub t039 (%abc) { join("/", map { $_."=".$abc{$_} } sort keys %abc) }
617is prototype(\&t039), undef;
618is eval("t039()"), "";
619is eval("t039(0)"), undef;
620like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#;
621is eval("t039(456)"), undef;
622like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#;
623is eval("t039(456, 789)"), "456=789";
624is eval("t039(456, 789, 987)"), undef;
625like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#;
626is eval("t039(456, 789, 987, 654)"), "456=789/987=654";
627is eval("t039(456, 789, 987, 654, 321)"), undef;
628like $@, qr#\AOdd name/value argument for subroutine 'main::t039' at \(eval \d+\) line 1\.\n\z#;
629is eval("t039(456, 789, 987, 654, 321, 111)"), "321=111/456=789/987=654";
630is $a, 123;
631
632eval "#line 8 foo\nsub t140 (\%abc = 222) { }";
633is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
634
635eval "#line 8 foo\nsub t141 (\%abc =) { }";
636is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
637
638sub t040 (%) { $a }
639is prototype(\&t040), undef;
640is eval("t040()"), 123;
641is eval("t040(0)"), undef;
642like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#;
643is eval("t040(456)"), undef;
644like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#;
645is eval("t040(456, 789)"), 123;
646is eval("t040(456, 789, 987)"), undef;
647like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#;
648is eval("t040(456, 789, 987, 654)"), 123;
649is eval("t040(456, 789, 987, 654, 321)"), undef;
650like $@, qr#\AOdd name/value argument for subroutine 'main::t040' at \(eval \d+\) line 1\.\n\z#;
651is eval("t040(456, 789, 987, 654, 321, 111)"), 123;
652is $a, 123;
653
654eval "#line 8 foo\nsub t142 (\% = 222) { }";
655is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
656
657eval "#line 8 foo\nsub t143 (\% =) { }";
658is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
659
660sub t041 ($a, @b) { $a.";".join("/", @b) }
661is prototype(\&t041), undef;
662is eval("t041()"), undef;
663like $@, qr/\AToo few arguments for subroutine 'main::t041' at \(eval \d+\) line 1\.\n\z/;
664is eval("t041(0)"), "0;";
665is eval("t041(456)"), "456;";
666is eval("t041(456, 789)"), "456;789";
667is eval("t041(456, 789, 987)"), "456;789/987";
668is eval("t041(456, 789, 987, 654)"), "456;789/987/654";
669is eval("t041(456, 789, 987, 654, 321)"), "456;789/987/654/321";
670is eval("t041(456, 789, 987, 654, 321, 111)"), "456;789/987/654/321/111";
671is $a, 123;
672
673sub t042 ($a, @) { $a.";" }
674is prototype(\&t042), undef;
675is eval("t042()"), undef;
676like $@, qr/\AToo few arguments for subroutine 'main::t042' at \(eval \d+\) line 1\.\n\z/;
677is eval("t042(0)"), "0;";
678is eval("t042(456)"), "456;";
679is eval("t042(456, 789)"), "456;";
680is eval("t042(456, 789, 987)"), "456;";
681is eval("t042(456, 789, 987, 654)"), "456;";
682is eval("t042(456, 789, 987, 654, 321)"), "456;";
683is eval("t042(456, 789, 987, 654, 321, 111)"), "456;";
684is $a, 123;
685
686sub t043 ($, @b) { $a.";".join("/", @b) }
687is prototype(\&t043), undef;
688is eval("t043()"), undef;
689like $@, qr/\AToo few arguments for subroutine 'main::t043' at \(eval \d+\) line 1\.\n\z/;
690is eval("t043(0)"), "123;";
691is eval("t043(456)"), "123;";
692is eval("t043(456, 789)"), "123;789";
693is eval("t043(456, 789, 987)"), "123;789/987";
694is eval("t043(456, 789, 987, 654)"), "123;789/987/654";
695is eval("t043(456, 789, 987, 654, 321)"), "123;789/987/654/321";
696is eval("t043(456, 789, 987, 654, 321, 111)"), "123;789/987/654/321/111";
697is $a, 123;
698
699sub t044 ($, @) { $a.";" }
700is prototype(\&t044), undef;
701is eval("t044()"), undef;
702like $@, qr/\AToo few arguments for subroutine 'main::t044' at \(eval \d+\) line 1\.\n\z/;
703is eval("t044(0)"), "123;";
704is eval("t044(456)"), "123;";
705is eval("t044(456, 789)"), "123;";
706is eval("t044(456, 789, 987)"), "123;";
707is eval("t044(456, 789, 987, 654)"), "123;";
708is eval("t044(456, 789, 987, 654, 321)"), "123;";
709is eval("t044(456, 789, 987, 654, 321, 111)"), "123;";
710is $a, 123;
711
712sub t049 ($a, %b) { $a.";".join("/", map { $_."=".$b{$_} } sort keys %b) }
713is prototype(\&t049), undef;
714is eval("t049()"), undef;
715like $@, qr/\AToo few arguments for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z/;
716is eval("t049(222)"), "222;";
717is eval("t049(222, 456)"), undef;
718like $@, qr#\AOdd name/value argument for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z#;
719is eval("t049(222, 456, 789)"), "222;456=789";
720is eval("t049(222, 456, 789, 987)"), undef;
721like $@, qr#\AOdd name/value argument for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z#;
722is eval("t049(222, 456, 789, 987, 654)"), "222;456=789/987=654";
723is eval("t049(222, 456, 789, 987, 654, 321)"), undef;
724like $@, qr#\AOdd name/value argument for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z#;
725is eval("t049(222, 456, 789, 987, 654, 321, 111)"),
726    "222;321=111/456=789/987=654";
727is $a, 123;
728
729sub t051 ($a, $b, $c, @d) { "$a;$b;$c;".join("/", @d).";".scalar(@d) }
730is prototype(\&t051), undef;
731is eval("t051()"), undef;
732like $@, qr/\AToo few arguments for subroutine 'main::t051' at \(eval \d+\) line 1\.\n\z/;
733is eval("t051(456)"), undef;
734like $@, qr/\AToo few arguments for subroutine 'main::t051' at \(eval \d+\) line 1\.\n\z/;
735is eval("t051(456, 789)"), undef;
736like $@, qr/\AToo few arguments for subroutine 'main::t051' at \(eval \d+\) line 1\.\n\z/;
737is eval("t051(456, 789, 987)"), "456;789;987;;0";
738is eval("t051(456, 789, 987, 654)"), "456;789;987;654;1";
739is eval("t051(456, 789, 987, 654, 321)"), "456;789;987;654/321;2";
740is eval("t051(456, 789, 987, 654, 321, 111)"), "456;789;987;654/321/111;3";
741is $a, 123;
742
743sub t052 ($a, $b, %c) { "$a;$b;".join("/", map { $_."=".$c{$_} } sort keys %c) }
744is prototype(\&t052), undef;
745is eval("t052()"), undef;
746like $@, qr/\AToo few arguments for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z/;
747is eval("t052(222)"), undef;
748like $@, qr/\AToo few arguments for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z/;
749is eval("t052(222, 333)"), "222;333;";
750is eval("t052(222, 333, 456)"), undef;
751like $@, qr#\AOdd name/value argument for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z#;
752is eval("t052(222, 333, 456, 789)"), "222;333;456=789";
753is eval("t052(222, 333, 456, 789, 987)"), undef;
754like $@, qr#\AOdd name/value argument for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z#;
755is eval("t052(222, 333, 456, 789, 987, 654)"), "222;333;456=789/987=654";
756is eval("t052(222, 333, 456, 789, 987, 654, 321)"), undef;
757like $@, qr#\AOdd name/value argument for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z#;
758is eval("t052(222, 333, 456, 789, 987, 654, 321, 111)"),
759    "222;333;321=111/456=789/987=654";
760is $a, 123;
761
762sub t053 ($a, $b, $c, %d) {
763    "$a;$b;$c;".join("/", map { $_."=".$d{$_} } sort keys %d)
764}
765is prototype(\&t053), undef;
766is eval("t053()"), undef;
767like $@, qr/\AToo few arguments for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z/;
768is eval("t053(222)"), undef;
769like $@, qr/\AToo few arguments for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z/;
770is eval("t053(222, 333)"), undef;
771like $@, qr/\AToo few arguments for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z/;
772is eval("t053(222, 333, 444)"), "222;333;444;";
773is eval("t053(222, 333, 444, 456)"), undef;
774like $@, qr#\AOdd name/value argument for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z#;
775is eval("t053(222, 333, 444, 456, 789)"), "222;333;444;456=789";
776is eval("t053(222, 333, 444, 456, 789, 987)"), undef;
777like $@, qr#\AOdd name/value argument for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z#;
778is eval("t053(222, 333, 444, 456, 789, 987, 654)"),
779    "222;333;444;456=789/987=654";
780is eval("t053(222, 333, 444, 456, 789, 987, 654, 321)"), undef;
781like $@, qr#\AOdd name/value argument for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z#;
782is eval("t053(222, 333, 444, 456, 789, 987, 654, 321, 111)"),
783    "222;333;444;321=111/456=789/987=654";
784is $a, 123;
785
786sub t048 ($a = 222, @b) { $a.";".join("/", @b).";".scalar(@b) }
787is prototype(\&t048), undef;
788is eval("t048()"), "222;;0";
789is eval("t048(0)"), "0;;0";
790is eval("t048(456)"), "456;;0";
791is eval("t048(456, 789)"), "456;789;1";
792is eval("t048(456, 789, 987)"), "456;789/987;2";
793is eval("t048(456, 789, 987, 654)"), "456;789/987/654;3";
794is eval("t048(456, 789, 987, 654, 321)"), "456;789/987/654/321;4";
795is eval("t048(456, 789, 987, 654, 321, 111)"), "456;789/987/654/321/111;5";
796is $a, 123;
797
798sub t054 ($a = 222, $b = 333, @c) { "$a;$b;".join("/", @c).";".scalar(@c) }
799is prototype(\&t054), undef;
800is eval("t054()"), "222;333;;0";
801is eval("t054(456)"), "456;333;;0";
802is eval("t054(456, 789)"), "456;789;;0";
803is eval("t054(456, 789, 987)"), "456;789;987;1";
804is eval("t054(456, 789, 987, 654)"), "456;789;987/654;2";
805is eval("t054(456, 789, 987, 654, 321)"), "456;789;987/654/321;3";
806is eval("t054(456, 789, 987, 654, 321, 111)"), "456;789;987/654/321/111;4";
807is $a, 123;
808
809sub t055 ($a = 222, $b = 333, $c = 444, @d) {
810    "$a;$b;$c;".join("/", @d).";".scalar(@d)
811}
812is prototype(\&t055), undef;
813is eval("t055()"), "222;333;444;;0";
814is eval("t055(456)"), "456;333;444;;0";
815is eval("t055(456, 789)"), "456;789;444;;0";
816is eval("t055(456, 789, 987)"), "456;789;987;;0";
817is eval("t055(456, 789, 987, 654)"), "456;789;987;654;1";
818is eval("t055(456, 789, 987, 654, 321)"), "456;789;987;654/321;2";
819is eval("t055(456, 789, 987, 654, 321, 111)"), "456;789;987;654/321/111;3";
820is $a, 123;
821
822sub t050 ($a = 211, %b) { $a.";".join("/", map { $_."=".$b{$_} } sort keys %b) }
823is prototype(\&t050), undef;
824is eval("t050()"), "211;";
825is eval("t050(222)"), "222;";
826is eval("t050(222, 456)"), undef;
827like $@, qr#\AOdd name/value argument for subroutine 'main::t050' at \(eval \d+\) line 1\.\n\z#;
828is eval("t050(222, 456, 789)"), "222;456=789";
829is eval("t050(222, 456, 789, 987)"), undef;
830like $@, qr#\AOdd name/value argument for subroutine 'main::t050' at \(eval \d+\) line 1\.\n\z#;
831is eval("t050(222, 456, 789, 987, 654)"), "222;456=789/987=654";
832is eval("t050(222, 456, 789, 987, 654, 321)"), undef;
833like $@, qr#\AOdd name/value argument for subroutine 'main::t050' at \(eval \d+\) line 1\.\n\z#;
834is eval("t050(222, 456, 789, 987, 654, 321, 111)"),
835    "222;321=111/456=789/987=654";
836is $a, 123;
837
838sub t056 ($a = 211, $b = 311, %c) {
839    "$a;$b;".join("/", map { $_."=".$c{$_} } sort keys %c)
840}
841is prototype(\&t056), undef;
842is eval("t056()"), "211;311;";
843is eval("t056(222)"), "222;311;";
844is eval("t056(222, 333)"), "222;333;";
845is eval("t056(222, 333, 456)"), undef;
846like $@, qr#\AOdd name/value argument for subroutine 'main::t056' at \(eval \d+\) line 1\.\n\z#;
847is eval("t056(222, 333, 456, 789)"), "222;333;456=789";
848is eval("t056(222, 333, 456, 789, 987)"), undef;
849like $@, qr#\AOdd name/value argument for subroutine 'main::t056' at \(eval \d+\) line 1\.\n\z#;
850is eval("t056(222, 333, 456, 789, 987, 654)"), "222;333;456=789/987=654";
851is eval("t056(222, 333, 456, 789, 987, 654, 321)"), undef;
852like $@, qr#\AOdd name/value argument for subroutine 'main::t056' at \(eval \d+\) line 1\.\n\z#;
853is eval("t056(222, 333, 456, 789, 987, 654, 321, 111)"),
854    "222;333;321=111/456=789/987=654";
855is $a, 123;
856
857sub t057 ($a = 211, $b = 311, $c = 411, %d) {
858    "$a;$b;$c;".join("/", map { $_."=".$d{$_} } sort keys %d)
859}
860is prototype(\&t057), undef;
861is eval("t057()"), "211;311;411;";
862is eval("t057(222)"), "222;311;411;";
863is eval("t057(222, 333)"), "222;333;411;";
864is eval("t057(222, 333, 444)"), "222;333;444;";
865is eval("t057(222, 333, 444, 456)"), undef;
866like $@, qr#\AOdd name/value argument for subroutine 'main::t057' at \(eval \d+\) line 1\.\n\z#;
867is eval("t057(222, 333, 444, 456, 789)"), "222;333;444;456=789";
868is eval("t057(222, 333, 444, 456, 789, 987)"), undef;
869like $@, qr#\AOdd name/value argument for subroutine 'main::t057' at \(eval \d+\) line 1\.\n\z#;
870is eval("t057(222, 333, 444, 456, 789, 987, 654)"),
871    "222;333;444;456=789/987=654";
872is eval("t057(222, 333, 444, 456, 789, 987, 654, 321)"), undef;
873like $@, qr#\AOdd name/value argument for subroutine 'main::t057' at \(eval \d+\) line 1\.\n\z#;
874is eval("t057(222, 333, 444, 456, 789, 987, 654, 321, 111)"),
875    "222;333;444;321=111/456=789/987=654";
876is $a, 123;
877
878sub t058 ($a, $b = 333, @c) { "$a;$b;".join("/", @c).";".scalar(@c) }
879is prototype(\&t058), undef;
880is eval("t058()"), undef;
881like $@, qr/\AToo few arguments for subroutine 'main::t058' at \(eval \d+\) line 1\.\n\z/;
882is eval("t058(456)"), "456;333;;0";
883is eval("t058(456, 789)"), "456;789;;0";
884is eval("t058(456, 789, 987)"), "456;789;987;1";
885is eval("t058(456, 789, 987, 654)"), "456;789;987/654;2";
886is eval("t058(456, 789, 987, 654, 321)"), "456;789;987/654/321;3";
887is eval("t058(456, 789, 987, 654, 321, 111)"), "456;789;987/654/321/111;4";
888is $a, 123;
889
890eval "#line 8 foo\nsub t059 (\@a, \$b) { }";
891is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
892
893eval "#line 8 foo\nsub t060 (\@a, \$b = 222) { }";
894is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
895
896eval "#line 8 foo\nsub t061 (\@a, \@b) { }";
897is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@b) "\n};
898
899eval "#line 8 foo\nsub t062 (\@a, \%b) { }";
900is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "%b) "\n};
901
902eval "#line 8 foo\nsub t063 (\@, \$b) { }";
903is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
904
905eval "#line 8 foo\nsub t064 (\@, \$b = 222) { }";
906is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
907
908eval "#line 8 foo\nsub t065 (\@, \@b) { }";
909is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@b) "\n};
910
911eval "#line 8 foo\nsub t066 (\@, \%b) { }";
912is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "%b) "\n};
913
914eval "#line 8 foo\nsub t067 (\@a, \$) { }";
915is $@, qq{Slurpy parameter not last at foo line 8, near "\$) "\n};
916
917eval "#line 8 foo\nsub t068 (\@a, \$ = 222) { }";
918is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
919
920eval "#line 8 foo\nsub t069 (\@a, \@) { }";
921is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@) "\n};
922
923eval "#line 8 foo\nsub t070 (\@a, \%) { }";
924is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\%) "\n};
925
926eval "#line 8 foo\nsub t071 (\@, \$) { }";
927is $@, qq{Slurpy parameter not last at foo line 8, near "\$) "\n};
928
929eval "#line 8 foo\nsub t072 (\@, \$ = 222) { }";
930is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
931
932eval "#line 8 foo\nsub t073 (\@, \@) { }";
933is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@) "\n};
934
935eval "#line 8 foo\nsub t074 (\@, \%) { }";
936is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\%) "\n};
937
938eval "#line 8 foo\nsub t075 (\%a, \$b) { }";
939is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
940
941eval "#line 8 foo\nsub t076 (\%, \$b) { }";
942is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
943
944eval "#line 8 foo\nsub t077 (\$a, \@b, \$c) { }";
945is $@, qq{Slurpy parameter not last at foo line 8, near "\$c) "\n};
946
947eval "#line 8 foo\nsub t078 (\$a, \%b, \$c) { }";
948is $@, qq{Slurpy parameter not last at foo line 8, near "\$c) "\n};
949
950eval "#line 8 foo\nsub t079 (\$a, \@b, \$c, \$d) { }";
951is $@, <<EOF;
952Slurpy parameter not last at foo line 8, near "\$c,"
953Slurpy parameter not last at foo line 8, near "\$d) "
954EOF
955
956sub t080 ($a,,, $b) { $a.$b }
957is prototype(\&t080), undef;
958is eval("t080()"), undef;
959like $@, qr/\AToo few arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/;
960is eval("t080(456)"), undef;
961like $@, qr/\AToo few arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/;
962is eval("t080(456, 789)"), "456789";
963is eval("t080(456, 789, 987)"), undef;
964like $@, qr/\AToo many arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/;
965is eval("t080(456, 789, 987, 654)"), undef;
966like $@, qr/\AToo many arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/;
967is $a, 123;
968
969sub t081 ($a, $b,,) { $a.$b }
970is prototype(\&t081), undef;
971is eval("t081()"), undef;
972like $@, qr/\AToo few arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/;
973is eval("t081(456)"), undef;
974like $@, qr/\AToo few arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/;
975is eval("t081(456, 789)"), "456789";
976is eval("t081(456, 789, 987)"), undef;
977like $@, qr/\AToo many arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/;
978is eval("t081(456, 789, 987, 654)"), undef;
979like $@, qr/\AToo many arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/;
980is $a, 123;
981
982eval "#line 8 foo\nsub t082 (, \$a) { }";
983is $@, qq{syntax error at foo line 8, near "(,"\n};
984
985eval "#line 8 foo\nsub t083 (,) { }";
986is $@, qq{syntax error at foo line 8, near "(,"\n};
987
988sub t084($a,$b){ $a.$b }
989is prototype(\&t084), undef;
990is eval("t084()"), undef;
991like $@, qr/\AToo few arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/;
992is eval("t084(456)"), undef;
993like $@, qr/\AToo few arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/;
994is eval("t084(456, 789)"), "456789";
995is eval("t084(456, 789, 987)"), undef;
996like $@, qr/\AToo many arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/;
997is eval("t084(456, 789, 987, 654)"), undef;
998like $@, qr/\AToo many arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/;
999is $a, 123;
1000
1001sub t085
1002    (
1003    $
1004    a
1005    ,
1006    ,
1007    $
1008    b
1009    =
1010    333
1011    ,
1012    ,
1013    )
1014    { $a.$b }
1015is prototype(\&t085), undef;
1016is eval("t085()"), undef;
1017like $@, qr/\AToo few arguments for subroutine 'main::t085' at \(eval \d+\) line 1\.\n\z/;
1018is eval("t085(456)"), "456333";
1019is eval("t085(456, 789)"), "456789";
1020is eval("t085(456, 789, 987)"), undef;
1021like $@, qr/\AToo many arguments for subroutine 'main::t085' at \(eval \d+\) line 1\.\n\z/;
1022is eval("t085(456, 789, 987, 654)"), undef;
1023like $@, qr/\AToo many arguments for subroutine 'main::t085' at \(eval \d+\) line 1\.\n\z/;
1024is $a, 123;
1025
1026sub 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 }
1040is prototype(\&t086), undef;
1041is eval("t086()"), undef;
1042like $@, qr/\AToo few arguments for subroutine 'main::t086' at \(eval \d+\) line 1\.\n\z/;
1043is eval("t086(456)"), "456333";
1044is eval("t086(456, 789)"), "456789";
1045is eval("t086(456, 789, 987)"), undef;
1046like $@, qr/\AToo many arguments for subroutine 'main::t086' at \(eval \d+\) line 1\.\n\z/;
1047is eval("t086(456, 789, 987, 654)"), undef;
1048like $@, qr/\AToo many arguments for subroutine 'main::t086' at \(eval \d+\) line 1\.\n\z/;
1049is $a, 123;
1050
1051sub 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 }
1065is prototype(\&t087), undef;
1066is eval("t087()"), undef;
1067like $@, qr/\AToo few arguments for subroutine 'main::t087' at \(eval \d+\) line 1\.\n\z/;
1068is eval("t087(456)"), "456333";
1069is eval("t087(456, 789)"), "456789";
1070is eval("t087(456, 789, 987)"), undef;
1071like $@, qr/\AToo many arguments for subroutine 'main::t087' at \(eval \d+\) line 1\.\n\z/;
1072is eval("t087(456, 789, 987, 654)"), undef;
1073like $@, qr/\AToo many arguments for subroutine 'main::t087' at \(eval \d+\) line 1\.\n\z/;
1074is $a, 123;
1075
1076eval "#line 8 foo\nsub t088 (\$ #foo\na) { }";
1077is $@, "";
1078
1079
1080eval "#line 8 foo\nsub t089 (\$#foo\na) { }";
1081like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(\$"\n};
1082
1083eval "#line 8 foo\nsub t090 (\@ #foo\na) { }";
1084is $@, "";
1085
1086eval "#line 8 foo\nsub t091 (\@#foo\na) { }";
1087like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(\@"\n};
1088
1089eval "#line 8 foo\nsub t092 (\% #foo\na) { }";
1090is $@, "";
1091
1092eval "#line 8 foo\nsub t093 (\%#foo\na) { }";
1093like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(%"\n};
1094
1095eval "#line 8 foo\nsub t094 (123) { }";
1096like $@, qr{\AA signature parameter must start with '\$', '\@' or '%' at foo line 8, near "\(1"\n};
1097
1098eval "#line 8 foo\nsub t095 (\$a, 123) { }";
1099is $@, <<EOF;
1100A signature parameter must start with '\$', '\@' or '%' at foo line 8, near ", 1"
1101syntax error at foo line 8, near ", 123"
1102EOF
1103
1104eval "#line 8 foo\nno warnings; sub t096 (\$a 123) { }";
1105is $@, <<'EOF';
1106Illegal operator following parameter in a subroutine signature at foo line 8, near "($a 123"
1107syntax error at foo line 8, near "($a 123"
1108EOF
1109
1110eval "#line 8 foo\nsub t097 (\$a { }) { }";
1111is $@, <<'EOF';
1112Illegal operator following parameter in a subroutine signature at foo line 8, near "($a { }"
1113syntax error at foo line 8, near "($a { }"
1114EOF
1115
1116eval "#line 8 foo\nsub t098 (\$a; \$b) { }";
1117is $@, <<'EOF';
1118Illegal operator following parameter in a subroutine signature at foo line 8, near "($a; "
1119syntax error at foo line 8, near "($a; "
1120EOF
1121
1122eval "#line 8 foo\nsub t099 (\$\$) { }";
1123is $@, <<EOF;
1124Illegal character following sigil in a subroutine signature at foo line 8, near "(\$"
1125syntax error at foo line 8, near "\$\$) "
1126EOF
1127
1128eval "#line 8 foo\nsub t101 (\@_) { }";
1129like $@, qr/\ACan't use global \@_ in "my" at foo line 8/;
1130
1131eval "#line 8 foo\nsub t102 (\%_) { }";
1132like $@, qr/\ACan't use global \%_ in "my" at foo line 8/;
1133
1134my $t103 = sub ($a) { $a || "z" };
1135is prototype($t103), undef;
1136is eval("\$t103->()"), undef;
1137like $@, qr/\AToo few arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/;
1138is eval("\$t103->(0)"), "z";
1139is eval("\$t103->(456)"), 456;
1140is eval("\$t103->(456, 789)"), undef;
1141like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/;
1142is eval("\$t103->(456, 789, 987)"), undef;
1143like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/;
1144is $a, 123;
1145
1146my $t118 = sub :prototype($) ($a) { $a || "z" };
1147is prototype($t118), "\$";
1148is eval("\$t118->()"), undef;
1149like $@, qr/\AToo few arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/;
1150is eval("\$t118->(0)"), "z";
1151is eval("\$t118->(456)"), 456;
1152is eval("\$t118->(456, 789)"), undef;
1153like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/;
1154is eval("\$t118->(456, 789, 987)"), undef;
1155like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/;
1156is $a, 123;
1157
1158sub t033 ($a = sub ($a) { $a."z" }) { $a->("a")."y" }
1159is prototype(\&t033), undef;
1160is eval("t033()"), "azy";
1161is eval("t033(sub { \"x\".\$_[0].\"x\" })"), "xaxy";
1162is eval("t033(sub { \"x\".\$_[0].\"x\" }, 789)"), undef;
1163like $@, qr/\AToo many arguments for subroutine 'main::t033' at \(eval \d+\) line 1\.\n\z/;
1164is $a, 123;
1165
1166sub t133 ($a = sub ($a = 222) { $a."z" }) { $a->()."/".$a->("a") }
1167is prototype(\&t133), undef;
1168is eval("t133()"), "222z/az";
1169is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" })"), "xux/xax";
1170is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" }, 789)"), undef;
1171like $@, qr/\AToo many arguments for subroutine 'main::t133' at \(eval \d+\) line 1\.\n\z/;
1172is $a, 123;
1173
1174sub t134 ($a = sub ($a, $t = sub { $_[0]."p" }) { $t->($a)."z" }) {
1175    $a->("a")."/".$a->("b", sub { $_[0]."q" } )
1176}
1177is prototype(\&t134), undef;
1178is eval("t134()"), "apz/bqz";
1179is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"),
1180    "xax/xbqx";
1181is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"),
1182    undef;
1183like $@, qr/\AToo many arguments for subroutine 'main::t134' at \(eval \d+\) line 1\.\n\z/;
1184is $a, 123;
1185
1186sub t135 ($a = sub ($a, $t = sub ($p) { $p."p" }) { $t->($a)."z" }) {
1187    $a->("a")."/".$a->("b", sub { $_[0]."q" } )
1188}
1189is prototype(\&t135), undef;
1190is eval("t135()"), "apz/bqz";
1191is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"),
1192    "xax/xbqx";
1193is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"),
1194    undef;
1195like $@, qr/\AToo many arguments for subroutine 'main::t135' at \(eval \d+\) line 1\.\n\z/;
1196is $a, 123;
1197
1198sub 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}
1203is prototype(\&t132), undef;
1204is eval("t132()"), "apz222p/bqzuq";
1205is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"),
1206    "xax/xbqx";
1207is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"),
1208    undef;
1209like $@, qr/\AToo many arguments for subroutine 'main::t132' at \(eval \d+\) line 1\.\n\z/;
1210is $a, 123;
1211
1212sub t104 :method ($a) { $a || "z" }
1213is prototype(\&t104), undef;
1214is eval("t104()"), undef;
1215like $@, qr/\AToo few arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/;
1216is eval("t104(0)"), "z";
1217is eval("t104(456)"), 456;
1218is eval("t104(456, 789)"), undef;
1219like $@, qr/\AToo many arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/;
1220is eval("t104(456, 789, 987)"), undef;
1221like $@, qr/\AToo many arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/;
1222is $a, 123;
1223
1224sub t105 :prototype($) ($a) { $a || "z" }
1225is prototype(\&t105), "\$";
1226is eval("t105()"), undef;
1227like $@, qr/\ANot enough arguments for main::t105 /;
1228is eval("t105(0)"), "z";
1229is eval("t105(456)"), 456;
1230is eval("t105(456, 789)"), undef;
1231like $@, qr/\AToo many arguments for main::t105 at \(eval \d+\) line 1, near/;
1232is eval("t105(456, 789, 987)"), undef;
1233like $@, qr/\AToo many arguments for main::t105 at \(eval \d+\) line 1, near/;
1234is $a, 123;
1235
1236sub t106 :prototype(@) ($a) { $a || "z" }
1237is prototype(\&t106), "\@";
1238is eval("t106()"), undef;
1239like $@, qr/\AToo few arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/;
1240is eval("t106(0)"), "z";
1241is eval("t106(456)"), 456;
1242is eval("t106(456, 789)"), undef;
1243like $@, qr/\AToo many arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/;
1244is eval("t106(456, 789, 987)"), undef;
1245like $@, qr/\AToo many arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/;
1246is $a, 123;
1247
1248eval "#line 8 foo\nsub t107(\$a) :method { }";
1249isnt $@, "";
1250
1251eval "#line 8 foo\nsub t108 (\$a) :prototype(\$) { }";
1252isnt $@, "";
1253
1254sub t109 { }
1255is prototype(\&t109), undef;
1256is scalar(@{[ t109() ]}), 0;
1257is scalar(t109()), undef;
1258
1259sub t110 () { }
1260is prototype(\&t110), undef;
1261is scalar(@{[ t110() ]}), 0;
1262is scalar(t110()), undef;
1263
1264sub t111 ($a) { }
1265is prototype(\&t111), undef;
1266is scalar(@{[ t111(222) ]}), 0;
1267is scalar(t111(222)), undef;
1268
1269sub t112 ($) { }
1270is prototype(\&t112), undef;
1271is scalar(@{[ t112(222) ]}), 0;
1272is scalar(t112(222)), undef;
1273
1274sub t114 ($a = undef) { }
1275is prototype(\&t114), undef;
1276is scalar(@{[ t114() ]}), 0;
1277is scalar(t114()), undef;
1278is scalar(@{[ t114(333) ]}), 0;
1279is scalar(t114(333)), undef;
1280
1281sub t113 ($a = 222) { }
1282is prototype(\&t113), undef;
1283is scalar(@{[ t113() ]}), 0;
1284is scalar(t113()), undef;
1285is scalar(@{[ t113(333) ]}), 0;
1286is scalar(t113(333)), undef;
1287
1288sub t115 ($a = do { $z++; 222 }) { }
1289is prototype(\&t115), undef;
1290$z = 0;
1291is scalar(@{[ t115() ]}), 0;
1292is $z, 1;
1293is scalar(t115()), undef;
1294is $z, 2;
1295is scalar(@{[ t115(333) ]}), 0;
1296is scalar(t115(333)), undef;
1297is $z, 2;
1298
1299sub t116 (@a) { }
1300is prototype(\&t116), undef;
1301is scalar(@{[ t116() ]}), 0;
1302is scalar(t116()), undef;
1303is scalar(@{[ t116(333) ]}), 0;
1304is scalar(t116(333)), undef;
1305
1306sub t117 (%a) { }
1307is prototype(\&t117), undef;
1308is scalar(@{[ t117() ]}), 0;
1309is scalar(t117()), undef;
1310is scalar(@{[ t117(333, 444) ]}), 0;
1311is scalar(t117(333, 444)), undef;
1312
1313sub t145 ($=3) { }
1314is 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
1479package T200 {
1480    sub foo ($x) {}
1481    *t201 = sub ($x) {}
1482}
1483*t202 = sub ($x) {};
1484my $t203 = sub ($x) {};
1485*t204 = *T200::foo;
1486*t205 = \&T200::foo;
1487
1488eval { T200::foo() };
1489like($@, qr/^Too few arguments for subroutine 'T200::foo'/);
1490eval { T200::t201() };
1491like($@, qr/^Too few arguments for subroutine 'T200::__ANON__'/);
1492eval { t202() };
1493like($@, qr/^Too few arguments for subroutine 'main::__ANON__'/);
1494eval { $t203->() };
1495like($@, qr/^Too few arguments for subroutine 'main::__ANON__'/);
1496eval { t204() };
1497like($@, qr/^Too few arguments for subroutine 'T200::foo'/);
1498eval { t205() };
1499like($@, 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
1505eval "sub (\x80";
1506like $@, qr/A signature parameter must start with/, "RT #130661";
1507
1508
1509
1510use File::Spec::Functions;
1511my $keywords_file = catfile(updir,'regen','keywords.pl');
1512open my $kh, $keywords_file
1513   or die "$0 cannot open $keywords_file: $!";
1514while(<$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
1556done_testing;
1557
15581;
1559