diff options
| -rw-r--r-- | t/comp/proto.t | 27 | ||||
| -rw-r--r-- | toke.c | 21 |
2 files changed, 45 insertions, 3 deletions
diff --git a/t/comp/proto.t b/t/comp/proto.t index 734a68bdfc..e785a9bdd6 100644 --- a/t/comp/proto.t +++ b/t/comp/proto.t @@ -18,7 +18,7 @@ BEGIN { # strict use strict; -print "1..153\n"; +print "1..160\n"; my $i = 1; @@ -651,3 +651,28 @@ print "ok ", $i++, "\n"; eval 'sub bug (\[%@]) { } my $array = [0 .. 1]; bug %$array;'; print "not " unless $@ =~ /Not a HASH reference/; print "ok ", $i++, "\n"; + +# [perl #75904] +# Test that the following prototypes make subs parse as unary functions: +# * \sigil \[...] ;$ ;* ;\sigil ;\[...] +print "not " + unless eval 'sub uniproto1 (*) {} uniproto1 $_, 1' or warn $@; +print "ok ", $i++, "\n"; +print "not " + unless eval 'sub uniproto2 (\$) {} uniproto2 $_, 1' or warn $@; +print "ok ", $i++, "\n"; +print "not " + unless eval 'sub uniproto3 (\[$%]) {} uniproto3 %_, 1' or warn $@; +print "ok ", $i++, "\n"; +print "not " + unless eval 'sub uniproto4 (;$) {} uniproto4 $_, 1' or warn $@; +print "ok ", $i++, "\n"; +print "not " + unless eval 'sub uniproto5 (;*) {} uniproto5 $_, 1' or warn $@; +print "ok ", $i++, "\n"; +print "not " + unless eval 'sub uniproto6 (;\@) {} uniproto6 @_, 1' or warn $@; +print "ok ", $i++, "\n"; +print "not " + unless eval 'sub uniproto7 (;\[$%@]) {} uniproto7 @_, 1' or warn $@; +print "ok ", $i++, "\n"; @@ -6495,10 +6495,27 @@ Perl_yylex(pTHX) const char *proto = SvPV_const(MUTABLE_SV(cv), protolen); if (!protolen) TERM(FUNC0SUB); - if ((*proto == '$' || *proto == '_') && proto[1] == '\0') - OPERATOR(UNIOPSUB); while (*proto == ';') proto++; + if ( + ( + ( + *proto == '$' || *proto == '_' + || *proto == '*' + ) + && proto[1] == '\0' + ) + || ( + *proto == '\\' && proto[1] && proto[2] == '\0' + ) + ) + OPERATOR(UNIOPSUB); + if (*proto == '\\' && proto[1] == '[') { + const char *p = proto + 2; + while(*p && *p != ']') + ++p; + if(*p == ']' && !p[1]) OPERATOR(UNIOPSUB); + } if (*proto == '&' && *s == '{') { if (PL_curstash) sv_setpvs(PL_subname, "__ANON__"); |