From d16269d8356f921e8939320f5cfd7d08d130c078 Mon Sep 17 00:00:00 2001
From: Peter Martini <PeterCMartini@GMail.com>
Date: Mon, 24 Jun 2013 17:58:46 -0400
Subject: [PATCH] Remove spaces from a (copy of) a proto when used. The logic
 that uses prototypes assumes spaces were already gone, which may not be true
 if they were added via XS / set_prototype.

---
 inline.h | 28 ++++++++++++++++++++++++++++
 op.c     |  1 +
 toke.c   |  1 +
 3 files changed, 30 insertions(+)

diff --git a/inline.h b/inline.h
index 29a15acf6077..00c59f5212b4 100644
--- a/inline.h
+++ b/inline.h
@@ -32,6 +32,34 @@ S_CvDEPTHp(const CV * const sv)
     return &((XPVCV*)SvANY(sv))->xcv_depth;
 }
 
+/*
+ CvPROTO returns the prototype as stored, which is not necessarily what
+ the interpreter should be using. Specifically, the interpreter assumes
+ that spaces have been stripped, which has been the case if the prototype
+ was added by toke.c, but is generally not the case if it was added elsewhere.
+ Since we can't enforce the spacelessness at assignment time, this routine
+ provides a temporary copy at parse time with spaces removed.
+ I<orig> is the start of the original buffer, I<len> is the length of the
+ prototype and will be updated when this returns.
+ */
+
+PERL_STATIC_INLINE char *
+S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
+{
+    SV * tmpsv;
+    char * tmps;
+    tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP);
+    tmps = SvPVX(tmpsv);
+    while ((*len)--) {
+	if (!isSPACE(*orig))
+	    *tmps++ = *orig;
+	orig++;
+    }
+    *tmps = '\0';
+    *len = tmps - SvPVX(tmpsv);
+		return SvPVX(tmpsv);
+}
+
 /* ----------------------------- regexp.h ----------------------------- */
 
 PERL_STATIC_INLINE struct regexp *
diff --git a/op.c b/op.c
index 18b065c9dca2..857e59fa4f6a 100644
--- a/op.c
+++ b/op.c
@@ -10078,6 +10078,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     if (SvTYPE(protosv) == SVt_PVCV)
 	 proto = CvPROTO(protosv), proto_len = CvPROTOLEN(protosv);
     else proto = SvPV(protosv, proto_len);
+    proto = S_strip_spaces(aTHX_ proto, &proto_len);
     proto_end = proto + proto_len;
     aop = cUNOPx(entersubop)->op_first;
     if (!aop->op_sibling)
diff --git a/toke.c b/toke.c
index 3493c5bbc0d7..0612011c922d 100644
--- a/toke.c
+++ b/toke.c
@@ -7281,6 +7281,7 @@ Perl_yylex(pTHX)
 			STRLEN protolen = CvPROTOLEN(cv);
 			const char *proto = CvPROTO(cv);
 			bool optional;
+			proto = S_strip_spaces(aTHX_ proto, &protolen);
 			if (!protolen)
 			    TERM(FUNC0SUB);
 			if ((optional = *proto == ';'))