X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/aff539aa0fc970a7b080a077309522932e179d10..a8c5635617479436b1775ba4ab34e4bc791eda54:/t/op/signatures.t diff --git a/t/op/signatures.t b/t/op/signatures.t index a1e3bff..37fe166 100644 --- a/t/op/signatures.t +++ b/t/op/signatures.t @@ -6,23 +6,26 @@ BEGIN { set_up_inc('../lib'); } -eval "#line 8 foo\nsub t004 :method (\$a) { }"; -is $@, "Experimental subroutine signatures not enabled at foo line 8\.\n", - "error when not enabled"; - -eval "#line 8 foo\nsub t005 (\$) (\$a) { }"; -is $@, "Experimental subroutine signatures not enabled at foo line 8\.\n", - "error when not enabled"; - -no warnings "illegalproto"; +use warnings; +use strict; our $a = 123; our $z; -sub t000 ($a) { $a || "z" } -is prototype(\&t000), "\$a", "(\$a) interpreted as protoype when not enabled"; -is &t000(456), 123, "(\$a) not signature when not enabled"; -is $a, 123; +{ + no warnings "illegalproto"; + sub t000 ($a) { $a || "z" } + is prototype(\&t000), "\$a", "(\$a) interpreted as protoype when not enabled"; + is &t000(456), 123, "(\$a) not signature when not enabled"; + is $a, 123; +} + +eval "#line 8 foo\nsub t004 :method (\$a) { }"; +like $@, qr{syntax error at foo line 8}, "error when not enabled 1"; + +eval "#line 8 foo\nsub t005 (\$) (\$a) { }"; +like $@, qr{syntax error at foo line 8}, "error when not enabled 2"; + no warnings "experimental::signatures"; use feature "signatures"; @@ -38,125 +41,125 @@ sub t002 () { $a || "z" } is prototype(\&t002), undef; is eval("t002()"), 123; is eval("t002(456)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t002' at \(eval \d+\) line 1\.\n\z/; is eval("t002(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t002' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t003 ( ) { $a || "z" } is prototype(\&t003), undef; is eval("t003()"), 123; is eval("t003(456)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t003' at \(eval \d+\) line 1\.\n\z/; is eval("t003(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t003' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t006 ($a) { $a || "z" } is prototype(\&t006), undef; is eval("t006()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/; is eval("t006(0)"), "z"; is eval("t006(456)"), 456; is eval("t006(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/; is eval("t006(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t007 ($a, $b) { $a.$b } is prototype(\&t007), undef; is eval("t007()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; is eval("t007(456)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; is eval("t007(456, 789)"), "456789"; is eval("t007(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; is eval("t007(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t008 ($a, $b, $c) { $a.$b.$c } is prototype(\&t008), undef; is eval("t008()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; is eval("t008(456)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; is eval("t008(456, 789)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; is eval("t008(456, 789, 987)"), "456789987"; is eval("t008(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t009 ($abc, $def) { $abc.$def } is prototype(\&t009), undef; is eval("t009()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; is eval("t009(456)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; is eval("t009(456, 789)"), "456789"; is eval("t009(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; is eval("t009(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t010 ($a, $) { $a || "z" } is prototype(\&t010), undef; is eval("t010()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; is eval("t010(456)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; is eval("t010(0, 789)"), "z"; is eval("t010(456, 789)"), 456; is eval("t010(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; is eval("t010(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t011 ($, $a) { $a || "z" } is prototype(\&t011), undef; is eval("t011()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; is eval("t011(456)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; is eval("t011(456, 0)"), "z"; is eval("t011(456, 789)"), 789; is eval("t011(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; is eval("t011(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t012 ($, $) { $a || "z" } is prototype(\&t012), undef; is eval("t012()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; is eval("t012(456)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; is eval("t012(0, 789)"), 123; is eval("t012(456, 789)"), 123; is eval("t012(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; is eval("t012(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t013 ($) { $a || "z" } is prototype(\&t013), undef; is eval("t013()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; is eval("t013(0)"), 123; is eval("t013(456)"), 123; is eval("t013(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; is eval("t013(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; is eval("t013(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t014 ($a = 222) { $a // "z" } @@ -166,9 +169,9 @@ is eval("t014(0)"), 0; is eval("t014(undef)"), "z"; is eval("t014(456)"), 456; is eval("t014(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t014' at \(eval \d+\) line 1\.\n\z/; is eval("t014(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t014' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t015 ($a = undef) { $a // "z" } @@ -178,9 +181,9 @@ is eval("t015(0)"), 0; is eval("t015(undef)"), "z"; is eval("t015(456)"), 456; is eval("t015(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t015' at \(eval \d+\) line 1\.\n\z/; is eval("t015(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t015' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t016 ($a = do { $z++; 222 }) { $a // "z" } @@ -192,9 +195,9 @@ is eval("t016(0)"), 0; is eval("t016(undef)"), "z"; is eval("t016(456)"), 456; is eval("t016(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t016' at \(eval \d+\) line 1\.\n\z/; is eval("t016(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t016' at \(eval \d+\) line 1\.\n\z/; is $z, 1; is eval("t016()"), 222; is $z, 2; @@ -210,9 +213,9 @@ is eval("t017(0)"), 0; is eval("t017(undef)"), "z"; is eval("t017(456)"), 456; is eval("t017(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t017' at \(eval \d+\) line 1\.\n\z/; is eval("t017(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t017' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t019 ($p = 222, $a = 333) { "$p/$a" } @@ -222,7 +225,7 @@ is eval("t019(0)"), "0/333"; is eval("t019(456)"), "456/333"; is eval("t019(456, 789)"), "456/789"; is eval("t019(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t019' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t020 :prototype($) { $_[0]."z" } @@ -233,7 +236,7 @@ is eval("t021(0)"), "0/333"; is eval("t021(456)"), "456/333"; is eval("t021(456, 789)"), "456/789"; is eval("t021(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t021' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t022 ($p = do { $z += 10; 222 }, $a = do { $z++; 333 }) { "$p/$a" } @@ -247,7 +250,7 @@ is eval("t022(456)"), "456/333"; is $z, 13; is eval("t022(456, 789)"), "456/789"; is eval("t022(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t022' at \(eval \d+\) line 1\.\n\z/; is $z, 13; is $a, 123; @@ -256,7 +259,7 @@ is prototype(\&t023), undef; is eval("t023()"), "azy"; is eval("t023(sub { \"x\".\$_[0].\"x\" })"), "xaxy"; is eval("t023(sub { \"x\".\$_[0].\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t023' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t036 ($a = $a."x") { $a."y" } @@ -265,7 +268,7 @@ is eval("t036()"), "123xy"; is eval("t036(0)"), "0y"; is eval("t036(456)"), "456y"; is eval("t036(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t036' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t120 ($a = $_) { $a // "z" } @@ -280,7 +283,7 @@ $_ = "___"; is eval("t120(456)"), 456; $_ = "___"; is eval("t120(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t120' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t121 ($a = caller) { $a // "z" } @@ -290,13 +293,13 @@ is eval("t121(undef)"), "z"; is eval("t121(0)"), 0; is eval("t121(456)"), 456; is eval("t121(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t121' at \(eval \d+\) line 1\.\n\z/; is eval("package T121::Z; ::t121()"), "T121::Z"; is eval("package T121::Z; ::t121(undef)"), "z"; is eval("package T121::Z; ::t121(0)"), 0; is eval("package T121::Z; ::t121(456)"), 456; is eval("package T121::Z; ::t121(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t121' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t129 ($a = return 222) { $a."x" } @@ -305,7 +308,7 @@ is eval("t129()"), "222"; is eval("t129(0)"), "0x"; is eval("t129(456)"), "456x"; is eval("t129(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t129' at \(eval \d+\) line 1\.\n\z/; is $a, 123; use feature "current_sub"; @@ -317,7 +320,7 @@ is eval("t122(1)"), "10"; is eval("t122(5)"), "543210"; is eval("t122(5, 789)"), "5789"; is eval("t122(5, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t122' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t123 ($list = wantarray) { $list ? "list" : "scalar" } @@ -329,7 +332,7 @@ is eval("(t123(0))[0]"), "scalar"; is eval("scalar(t123(1))"), "list"; is eval("(t123(1))[0]"), "list"; is eval("t123(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t123' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t124 ($b = (local $a = $a + 1)) { "$a/$b" } @@ -339,7 +342,7 @@ is $a, 123; is eval("t124(456)"), "123/456"; is $a, 123; is eval("t124(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t124' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t125 ($c = (our $t125_counter)++) { $c } @@ -352,7 +355,7 @@ is eval("t125(789)"), 789; is eval("t125()"), 3; is eval("t125()"), 4; is eval("t125(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t125' at \(eval \d+\) line 1\.\n\z/; is $a, 123; use feature "state"; @@ -368,7 +371,7 @@ is $z, 223; is eval("t126()"), 222; is $z, 223; is eval("t126(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t126' at \(eval \d+\) line 1\.\n\z/; is $z, 223; is $a, 123; @@ -387,7 +390,7 @@ is eval("t127(789)"), 789; is eval("t127()"), 225; is eval("t127()"), 226; is eval("t127(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t127' at \(eval \d+\) line 1\.\n\z/; is $z, 223; is $a, 123; @@ -398,7 +401,7 @@ is eval("t037(0)"), "0/0x"; is eval("t037(456)"), "456/456x"; is eval("t037(456, 789)"), "456/789"; is eval("t037(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t037' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t128 ($a = 222, $b = ($a = 333)) { "$a/$b" } @@ -408,7 +411,7 @@ is eval("t128(0)"), "333/333"; is eval("t128(456)"), "333/333"; is eval("t128(456, 789)"), "456/789"; is eval("t128(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t128' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t130 { join(",", @_).";".scalar(@_) } @@ -419,11 +422,12 @@ is eval("t131(0)"), "0;1"; is eval("t131(456)"), "456;1"; is eval("t131(456, 789)"), "456/789"; is eval("t131(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t131' at \(eval \d+\) line 1\.\n\z/; is $a, 123; eval "#line 8 foo\nsub t024 (\$a =) { }"; -is $@, "Optional parameter lacks default expression at foo line 8\.\n"; +is $@, + qq{Optional parameter lacks default expression at foo line 8, near "=) "\n}; sub t025 ($ = undef) { $a // "z" } is prototype(\&t025), undef; @@ -431,11 +435,11 @@ is eval("t025()"), 123; is eval("t025(0)"), 123; is eval("t025(456)"), 123; is eval("t025(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/; is eval("t025(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/; is eval("t025(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t026 ($ = 222) { $a // "z" } @@ -444,11 +448,11 @@ is eval("t026()"), 123; is eval("t026(0)"), 123; is eval("t026(456)"), 123; is eval("t026(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/; is eval("t026(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/; is eval("t026(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t032 ($ = do { $z++; 222 }) { $a // "z" } @@ -459,11 +463,11 @@ is $z, 1; is eval("t032(0)"), 123; is eval("t032(456)"), 123; is eval("t032(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/; is eval("t032(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/; is eval("t032(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/; is $z, 1; is $a, 123; @@ -473,11 +477,11 @@ is eval("t027()"), 123; is eval("t027(0)"), 123; is eval("t027(456)"), 123; is eval("t027(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/; is eval("t027(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/; is eval("t027(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t119 ($ =, $a = 333) { $a // "z" } @@ -487,88 +491,91 @@ is eval("t119(0)"), 333; is eval("t119(456)"), 333; is eval("t119(456, 789)"), 789; is eval("t119(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t119' at \(eval \d+\) line 1\.\n\z/; is eval("t119(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t119' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t028 ($a, $b = 333) { "$a/$b" } is prototype(\&t028), undef; is eval("t028()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t028' at \(eval \d+\) line 1\.\n\z/; is eval("t028(0)"), "0/333"; is eval("t028(456)"), "456/333"; is eval("t028(456, 789)"), "456/789"; is eval("t028(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t028' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t045 ($a, $ = 333) { "$a/" } is prototype(\&t045), undef; is eval("t045()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t045' at \(eval \d+\) line 1\.\n\z/; is eval("t045(0)"), "0/"; is eval("t045(456)"), "456/"; is eval("t045(456, 789)"), "456/"; is eval("t045(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t045' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t046 ($, $b = 333) { "$a/$b" } is prototype(\&t046), undef; is eval("t046()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t046' at \(eval \d+\) line 1\.\n\z/; is eval("t046(0)"), "123/333"; is eval("t046(456)"), "123/333"; is eval("t046(456, 789)"), "123/789"; is eval("t046(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t046' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t047 ($, $ = 333) { "$a/" } is prototype(\&t047), undef; is eval("t047()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t047' at \(eval \d+\) line 1\.\n\z/; is eval("t047(0)"), "123/"; is eval("t047(456)"), "123/"; is eval("t047(456, 789)"), "123/"; is eval("t047(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t047' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t029 ($a, $b, $c = 222, $d = 333) { "$a/$b/$c/$d" } is prototype(\&t029), undef; is eval("t029()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; is eval("t029(0)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; is eval("t029(456)"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; is eval("t029(456, 789)"), "456/789/222/333"; is eval("t029(456, 789, 987)"), "456/789/987/333"; is eval("t029(456, 789, 987, 654)"), "456/789/987/654"; is eval("t029(456, 789, 987, 654, 321)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; is eval("t029(456, 789, 987, 654, 321, 111)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t038 ($a, $b = $a."x") { "$a/$b" } is prototype(\&t038), undef; is eval("t038()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t038' at \(eval \d+\) line 1\.\n\z/; is eval("t038(0)"), "0/0x"; is eval("t038(456)"), "456/456x"; is eval("t038(456, 789)"), "456/789"; is eval("t038(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t038' at \(eval \d+\) line 1\.\n\z/; is $a, 123; eval "#line 8 foo\nsub t030 (\$a = 222, \$b) { }"; -is $@, "Mandatory parameter follows optional parameter at foo line 8\.\n"; +is $@, qq{Mandatory parameter follows optional parameter at foo line 8, near "\$b) "\n}; eval "#line 8 foo\nsub t031 (\$a = 222, \$b = 333, \$c, \$d) { }"; -is $@, "Mandatory parameter follows optional parameter at foo line 8\.\n"; +is $@, <()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; is eval("\$t103->(0)"), "z"; is eval("\$t103->(456)"), 456; is eval("\$t103->(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; is eval("\$t103->(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; is $a, 123; my $t118 = sub :prototype($) ($a) { $a || "z" }; is prototype($t118), "\$"; is eval("\$t118->()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; is eval("\$t118->(0)"), "z"; is eval("\$t118->(456)"), 456; is eval("\$t118->(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; is eval("\$t118->(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t033 ($a = sub ($a) { $a."z" }) { $a->("a")."y" } @@ -1152,7 +1160,7 @@ is prototype(\&t033), undef; is eval("t033()"), "azy"; is eval("t033(sub { \"x\".\$_[0].\"x\" })"), "xaxy"; is eval("t033(sub { \"x\".\$_[0].\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t033' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t133 ($a = sub ($a = 222) { $a."z" }) { $a->()."/".$a->("a") } @@ -1160,7 +1168,7 @@ is prototype(\&t133), undef; is eval("t133()"), "222z/az"; is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" })"), "xux/xax"; is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t133' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t134 ($a = sub ($a, $t = sub { $_[0]."p" }) { $t->($a)."z" }) { @@ -1172,7 +1180,7 @@ is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), "xax/xbqx"; is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t134' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t135 ($a = sub ($a, $t = sub ($p) { $p."p" }) { $t->($a)."z" }) { @@ -1184,7 +1192,7 @@ is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), "xax/xbqx"; is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t135' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t132 ( @@ -1198,19 +1206,19 @@ is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), "xax/xbqx"; is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t132' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t104 :method ($a) { $a || "z" } is prototype(\&t104), undef; is eval("t104()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/; is eval("t104(0)"), "z"; is eval("t104(456)"), 456; is eval("t104(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/; is eval("t104(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/; is $a, 123; sub t105 :prototype($) ($a) { $a || "z" } @@ -1228,16 +1236,16 @@ is $a, 123; sub t106 :prototype(@) ($a) { $a || "z" } is prototype(\&t106), "\@"; is eval("t106()"), undef; -like $@, qr/\AToo few arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo few arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/; is eval("t106(0)"), "z"; is eval("t106(456)"), 456; is eval("t106(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/; is eval("t106(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/; +like $@, qr/\AToo many arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/; is $a, 123; -eval "#line 8 foo\nsub t107 (\$a) :method { }"; +eval "#line 8 foo\nsub t107(\$a) :method { }"; isnt $@, ""; eval "#line 8 foo\nsub t108 (\$a) :prototype(\$) { }"; @@ -1302,6 +1310,203 @@ is scalar(t117()), undef; is scalar(@{[ t117(333, 444) ]}), 0; is scalar(t117(333, 444)), undef; +sub t145 ($=3) { } +is scalar(t145()), undef; + +{ + my $want; + sub want { $want = wantarray ? "list" + : defined(wantarray) ? "scalar" : "void"; 1 } + + sub t144 ($a = want()) { $a } + t144(); + is ($want, "scalar", "default expression is scalar in void context"); + my $x = t144(); + is ($want, "scalar", "default expression is scalar in scalar context"); + () = t144(); + is ($want, "scalar", "default expression is scalar in list context"); +} + + +# check for default arg code doing nasty things (closures, gotos, +# modifying @_ etc). + +{ + no warnings qw(closure); + use Tie::Array; + use Tie::Hash; + + sub t146 ($a = t146x()) { + sub t146x { $a = "abc"; 1 } + $a; + } + is t146(), 1, "t146: closure can make new lexical not undef"; + + sub t147 ($a = t147x()) { + sub t147x { $a = "abc"; pos($a)=1; 1 } + is pos($a), undef, "t147: pos magic cleared"; + $a; + } + is t147(), 1, "t147: closure can make new lexical not undef and magical"; + + sub t148 ($a = t148x()) { + sub t148x { $a = []; 1 } + $a; + } + is t148(), 1, "t148: closure can make new lexical a ref"; + + sub t149 ($a = t149x()) { + sub t149x { $a = 1; [] } + $a; + } + is ref(t149()), "ARRAY", "t149: closure can make new lexical a ref"; + + sub t150 ($a = do {@_ = qw(a b c); 1}, $b = 2) { + is $a, 1, "t150: a: growing \@_"; + is $b, "b", "t150: b: growing \@_"; + } + t150(); + + + sub t151 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, $b = 2) { + is $a, 1, "t151: a: tied \@_"; + is $b, "b", "t151: b: tied \@_"; + } + t151(); + + sub t152 ($a = t152x(), @b) { + sub t152x { @b = qw(a b c); 1 } + $a . '-' . join(':', @b); + } + is t152(), "1-", "t152: closure can make new lexical array non-empty"; + + sub t153 ($a = t153x(), %b) { + sub t153x { %b = qw(a 10 b 20); 1 } + $a . '-' . join(':', sort %b); + } + is t153(), "1-", "t153: closure can make new lexical hash non-empty"; + + sub t154 ($a = t154x(), @b) { + sub t154x { tie @b, 'Tie::StdArray'; @b = qw(a b c); 1 } + $a . '-' . join(':', @b); + } + is t154(), "1-", "t154: closure can make new lexical array tied"; + + sub t155 ($a = t155x(), %b) { + sub t155x { tie %b, 'Tie::StdHash'; %b = qw(a 10 b 20); 1 } + $a . '-' . join(':', sort %b); + } + is t155(), "1-", "t155: closure can make new lexical hash tied"; + + sub t156 ($a = do {@_ = qw(a b c); 1}, @b) { + is $a, 1, "t156: a: growing \@_"; + is "@b", "b c", "t156: b: growing \@_"; + } + t156(); + + sub t157 ($a = do {@_ = qw(a b c); 1}, %b) { + is $a, 1, "t157: a: growing \@_"; + is join(':', sort %b), "b:c", "t157: b: growing \@_"; + } + t157(); + + sub t158 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, @b) { + is $a, 1, "t158: a: tied \@_"; + is "@b", "b c", "t158: b: tied \@_"; + } + t158(); + + sub t159 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, %b) { + is $a, 1, "t159: a: tied \@_"; + is join(':', sort %b), "b:c", "t159: b: tied \@_"; + } + t159(); + + # see if we can handle the equivalent of @a = ($a[1], $a[0]) + + sub t160 ($s, @a) { + sub t160x { + @a = qw(x y); + t160(1, $a[1], $a[0]); + } + # encourage recently-freed SVPVs to be realloced with new values + my @pad = qw(a b); + join ':', $s, @a; + } + is t160x(), "1:y:x", 'handle commonality in slurpy array'; + + # see if we can handle the equivalent of %h = ('foo', $h{foo}) + + sub t161 ($s, %h) { + sub t161x { + %h = qw(k1 v1 k2 v2); + t161(1, k1 => $h{k2}, k2 => $h{k1}); + } + # encourage recently-freed SVPVs to be realloced with new values + my @pad = qw(a b); + join ' ', $s, map "($_,$h{$_})", sort keys %h; + } + is t161x(), "1 (k1,v2) (k2,v1)", 'handle commonality in slurpy hash'; + + # see if we can handle the equivalent of ($a,$b) = ($b,$a) + # Note that for non-signatured subs, my ($a,$b) = @_ already fails the + # equivalent of this test too, since I skipped pessimising it + # (90ce4d057857) as commonality in this case is rare and contrived, + # as the example below shows. DAPM. + sub t162 ($a, $b) { + sub t162x { + ($a, $b) = qw(x y); + t162($b, $a); + } + "$a:$b"; + } + { + local $::TODO = q{can't handle commonaility}; + is t162x(), "y:x", 'handle commonality in scalar parms'; + } +} + +{ + my $w; + local $SIG{__WARN__} = sub { $w .= "@_" }; + is eval q{sub ($x,$x) { $x}->(1,2)}, 2, "duplicate sig var names"; + like $w, qr/^"my" variable \$x masks earlier declaration in same scope/, + "masking warning"; +} + +# Reporting subroutine names + +package T200 { + sub foo ($x) {} + *t201 = sub ($x) {} +} +*t202 = sub ($x) {}; +my $t203 = sub ($x) {}; +*t204 = *T200::foo; +*t205 = \&T200::foo; + +eval { T200::foo() }; +like($@, qr/^Too few arguments for subroutine 'T200::foo'/); +eval { T200::t201() }; +like($@, qr/^Too few arguments for subroutine 'T200::__ANON__'/); +eval { t202() }; +like($@, qr/^Too few arguments for subroutine 'main::__ANON__'/); +eval { $t203->() }; +like($@, qr/^Too few arguments for subroutine 'main::__ANON__'/); +eval { t204() }; +like($@, qr/^Too few arguments for subroutine 'T200::foo'/); +eval { t205() }; +like($@, qr/^Too few arguments for subroutine 'T200::foo'/); + + +# RT #130661 a char >= 0x80 in a signature when a sigil was expected +# was triggering an assertion + +eval "sub (\x80"; +like $@, qr/A signature parameter must start with/, "RT #130661"; + + + use File::Spec::Functions; my $keywords_file = catfile(updir,'regen','keywords.pl'); open my $kh, $keywords_file @@ -1311,15 +1516,43 @@ while(<$kh>) { chomp(my $word = $'); # $y should be an error after $x=foo. The exact error we get may # differ if this is __END__ or s or some other special keyword. - eval 'sub ($x = ' . $word . ', $y) {}'; - local $::TODO = 'does not work yet' - if $word =~ /^(?:chmod|chown|die|exec|glob|kill|mkdir|print - |printf|return|reverse|select|setpgrp|sort|split - |system|unlink|utime|warn)\z/x; + eval 'no warnings; sub ($x = ' . $word . ', $y) {}'; isnt $@, "", "$word does not swallow trailing comma"; } } +# RT #132141 +# Attributes such as lvalue have to come *before* the signature to +# ensure that they're applied to any code block within the signature + +{ + my $x; + sub f :lvalue ($a = do { $x = "abc"; return substr($x,0,1)}) { + die; # notreached + } + + f() = "X"; + is $x, "Xbc", "RT #132141"; +} + +# RT #132760 +# attributes have been moved back before signatures for 5.28. Ensure that +# code doing it the old wrong way get a meaningful error message. + +{ + my @errs; + local $SIG{__WARN__} = sub { push @errs, @_}; + eval q{ + sub rt132760 ($a, $b) :prototype($$) { $a + $b } + }; + + @errs = split /\n/, $@; + is +@errs, 1, "RT 132760 expect 1 error"; + like $errs[0], + qr/^Subroutine attributes must come before the signature at/, + "RT 132760 err 0"; +} + done_testing; 1;