From: Sam Tregar <sam@tregar.com>
Date: Mon, 31 Dec 2001 00:50:30 +0000 (-0500)
Subject: Re: [PATCH] Basic bad prototype detection
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d731386ac2ca77cd1b2028551263c37a4ebe0903;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] Basic bad prototype detection
Message-ID: <Pine.LNX.4.33.0112310017090.9102-200000@localhost.localdomain>

p4raw-id: //depot/perl@13974
---

diff --git a/t/comp/proto.t b/t/comp/proto.t
index b42a5cc..da3af28 100755
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use strict;
 
-print "1..133\n";
+print "1..134\n";
 
 my $i = 1;
 
@@ -541,3 +541,7 @@ eval 'sub badproto3 (&$bar$@) { 1; }';
 print "not " unless $@ =~ /^Malformed prototype for main::badproto3 : &\$bar\$\@/;
 print "ok ", $i++, "\n";
 
+eval 'sub badproto4 (@ $b ar) { 1; }';
+print "not " unless $@ =~ /^Malformed prototype for main::badproto4 : \@\$bar/;
+print "ok ", $i++, "\n";
+
diff --git a/toke.c b/toke.c
index 55aaedb..faa1eac 100644
--- a/toke.c
+++ b/toke.c
@@ -4904,7 +4904,7 @@ Perl_yylex(pTHX)
 		char tmpbuf[sizeof PL_tokenbuf];
 		SSize_t tboffset = 0;
 		expectation attrful;
-		bool have_name, have_proto;
+		bool have_name, have_proto, bad_proto;
 		int key = tmp;
 
 		s = skipspace(s);
@@ -4955,14 +4955,17 @@ Perl_yylex(pTHX)
 		    /* strip spaces and check for bad characters */
 		    d = SvPVX(PL_lex_stuff);
 		    tmp = 0;
+		    bad_proto = FALSE;
 		    for (p = d; *p; ++p) {
-		        if (!strchr("$@%*;[]&\\ ", *p))
-			    Perl_croak(aTHX_ "Malformed prototype for %s : %s",
-				       SvPVX(PL_subname), d);
+			if (!strchr("$@%*;[]&\\ ", *p))
+			    bad_proto = TRUE;
 			if (!isSPACE(*p))
 			    d[tmp++] = *p;
 		    }
 		    d[tmp] = '\0';
+		    if (bad_proto)
+			Perl_croak(aTHX_ "Malformed prototype for %s : %s",
+				   SvPVX(PL_subname), d);
 		    SvCUR(PL_lex_stuff) = tmp;
 		    have_proto = TRUE;