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