summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSam Tregar <sam@tregar.com>2001-12-30 19:50:30 -0500
committerJarkko Hietaniemi <jhi@iki.fi>2001-12-31 04:59:53 +0000
commitd731386ac2ca77cd1b2028551263c37a4ebe0903 (patch)
treec94767be294d0181308d1d92591c7a02336fd751
parent86761af6df5a6fd2895b68fe934f1d2b3d92df3e (diff)
downloadperl-d731386ac2ca77cd1b2028551263c37a4ebe0903.tar.gz
Re: [PATCH] Basic bad prototype detection
Message-ID: <Pine.LNX.4.33.0112310017090.9102-200000@localhost.localdomain> p4raw-id: //depot/perl@13974
-rwxr-xr-xt/comp/proto.t6
-rw-r--r--toke.c11
2 files changed, 12 insertions, 5 deletions
diff --git a/t/comp/proto.t b/t/comp/proto.t
index b42a5cc4c5..da3af2890d 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 55aaedbea1..faa1eac4c2 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;