diff options
author | Sam Tregar <sam@tregar.com> | 2001-12-30 19:50:30 -0500 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-12-31 04:59:53 +0000 |
commit | d731386ac2ca77cd1b2028551263c37a4ebe0903 (patch) | |
tree | c94767be294d0181308d1d92591c7a02336fd751 | |
parent | 86761af6df5a6fd2895b68fe934f1d2b3d92df3e (diff) | |
download | perl-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-x | t/comp/proto.t | 6 | ||||
-rw-r--r-- | toke.c | 11 |
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"; + @@ -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; |