From 80e09529483332d99472e6944c1f7b1abc89c89c Mon Sep 17 00:00:00 2001
From: Peter Martini <PeterCMartini@GMail.com>
Date: Sat, 22 Jun 2013 00:09:12 -0400
Subject: [PATCH] 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.
---
 t/comp/proto.t | 25 ++++++++++++++++++++++++-
 toke.c         | 14 +++++++-------
 2 files changed, 31 insertions(+), 8 deletions(-)

diff --git a/t/comp/proto.t b/t/comp/proto.t
index d5e4d5b..51d1463 100644
--- 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
--- 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 == '$') {
-- 
2.7.4