Treat a consecutive semicolons in a prototype as 1

This also intentionally ignores spaces; they're ignored by
the toker, but if the prototype was set externally, they
may have leaked in. This is just for the method/not method
checks.

diff --git a/t/comp/proto.t b/t/comp/proto.t
index d5e4d5b..51d1463 100644 (file)
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -18,7 +18,7 @@ BEGIN {
 # strict
 use strict;
 
-print "1..180\n";
+print "1..186\n";
 
 my $i = 1;
 
@@ -550,6 +550,15 @@ star2(\*FOO, \*BAR, sub {
        print "ok $i - star2(\*FOO, \*BAR)\n";
     }); $i++;
 
+# [perl #118585]
+# Test that multiple semicolons are treated as one with *
+sub star3(;;;*){}
+sub star4( ; ; ; ; *){}
+print "not " unless eval 'star3 STDERR; 1';
+print "ok ", $i++, " star3 STDERR\n";
+print "not " unless eval 'star4 STDERR; 1';
+print "ok ", $i++, " star4 STDERR\n";
+
 # test scalarref prototype
 sub sreftest (\$$) {
     print "not " unless ref $_[0];
@@ -688,6 +697,8 @@ print "ok ", $i++, "\n";
 # [perl #75904]
 # Test that the following prototypes make subs parse as unary functions:
 #  * \sigil \[...] ;$ ;* ;\sigil ;\[...]
+# [perl #118585]
+# As a special case, make sure that ;;* is treated the same as ;*
 print "not "
  unless eval 'sub uniproto1 (*) {} uniproto1 $_, 1' or warn $@;
 print "ok ", $i++, "\n";
@@ -715,6 +726,18 @@ print "ok ", $i++, "\n";
 print "not "
  unless eval 'sub uniproto9 (;+) {} uniproto9 $_, 1' or warn $@;
 print "ok ", $i++, "\n";
+print "not "
+ unless eval 'sub uniproto10 (;;;*) {} uniproto10 $_, 1' or warn $@;
+print "ok ", $i++, " - uniproto10 (;;;*)\n";
+print "not "
+ unless eval 'sub uniproto11 ( ; ; ; * ) {} uniproto10 $_, 1' or warn $@;
+print "ok ", $i++, " - uniproto11 ( ; ; ;  *)\n";
+print "not "
+ unless eval 'sub uniproto12 (;;;+) {} uniproto12 $_, 1' or warn $@;
+print "ok ", $i++, " - uniproto12 (;;;*)\n";
+print "not "
+ unless eval 'sub uniproto12 ( ; ; ; + ) {} uniproto12 $_, 1' or warn $@;
+print "ok ", $i++, " - uniproto12 ( ; ; ; * )\n";
 
 # Test that a trailing semicolon makes a sub have listop precedence
 sub unilist ($;)  { $_[0]+1 }

diff --git a/toke.c b/toke.c
index 5ad89f1..0a16715 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3995,13 +3995,13 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
     if (gv && SvTYPE(gv) == SVt_PVGV && GvIO(gv))
            return 0;
     if (cv && SvPOK(cv)) {
-               const char *proto = CvPROTO(cv);
-               if (proto) {
-                   if (*proto == ';')
-                       proto++;
-                   if (*proto == '*')
-                       return 0;
-               }
+       const char *proto = CvPROTO(cv);
+       if (proto) {
+           while (*proto && (isSPACE(*proto) || *proto == ';'))
+               proto++;
+           if (*proto == '*')
+               return 0;
+       }
     }
 
     if (*start == '$') {