In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/29179484f257f0cbf448b1d9ee80035b7268a540?hp=0c46edc2ed84a018c7aeb5f4ac8a662028bc8a9b>
- Log ----------------------------------------------------------------- commit 29179484f257f0cbf448b1d9ee80035b7268a540 Author: Father Chrysostomos <[email protected]> Date: Tue Nov 25 05:53:06 2014 -0800 [perl #77860] \& proto should disallow sub calls It was checking to see whether its argument were an entersub op (&foo is indeed an entersub) and then wrapping it in refgen (\). But enter- sub also covers &foo() and foo() and foo. op_lvalue checks whether the OPf_STACKED flag is set and only turns it into rv2cv if it is not. (Only &foo lacks that flag.) So I copied that logic into prototype application. ----------------------------------------------------------------------- Summary of changes: op.c | 5 +++-- t/comp/proto.t | 13 ++++++++++++- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/op.c b/op.c index 0d8463c..05ba025 100644 --- a/op.c +++ b/op.c @@ -11230,10 +11230,11 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) bad_type_gv(arg, "symbol", namegv, 0, o3); break; case '&': - if (o3->op_type == OP_ENTERSUB) + if (o3->op_type == OP_ENTERSUB + && !(o3->op_flags & OPf_STACKED)) goto wrapref; if (!contextclass) - bad_type_gv(arg, "subroutine entry", namegv, 0, + bad_type_gv(arg, "subroutine", namegv, 0, o3); break; case '$': diff --git a/t/comp/proto.t b/t/comp/proto.t index 34c998e..ec96cad 100644 --- a/t/comp/proto.t +++ b/t/comp/proto.t @@ -18,7 +18,7 @@ BEGIN { # strict use strict; -print "1..211\n"; +print "1..214\n"; my $i = 1; @@ -325,6 +325,17 @@ a_subx &tmp_sub_2; eval 'a_subx @array'; print "not " unless $@; printf "ok %d\n",$i++; +my $bad = + qr/Type of arg 1 to .* must be subroutine \(not subroutine entry\)/; +eval 'a_subx &tmp_sub_2()'; +print "not " unless $@ =~ $bad; +printf "ok %d - \\& prohibits &foo()\n",$i++; +eval 'a_subx tmp_sub_2()'; +print "not " unless $@ =~ $bad; +printf "ok %d - \\& prohibits foo()\n",$i++; +eval 'a_subx tmp_sub_2'; +print "not " unless $@ =~ $bad; +printf "ok %d - \\& prohibits foo where foo is an existing sub\n",$i++; ## ## -- Perl5 Master Repository
