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;