Change 13974 by jhi@alpha on 2001/12/31 04:59:53

        Subject: Re: [PATCH] Basic bad prototype detection
        From: Sam Tregar <[EMAIL PROTECTED]>
        Date: Mon, 31 Dec 2001 00:50:30 -0500 (EST)
        Message-ID: <[EMAIL PROTECTED]>

Affected files ...

.... //depot/perl/t/comp/proto.t#32 edit
.... //depot/perl/toke.c#403 edit

Differences ...

==== //depot/perl/t/comp/proto.t#32 (xtext) ====
Index: perl/t/comp/proto.t
--- perl/t/comp/proto.t.~1~     Sun Dec 30 22:15:05 2001
+++ perl/t/comp/proto.t Sun Dec 30 22:15:05 2001
@@ -16,7 +16,7 @@
 
 use strict;
 
-print "1..133\n";
+print "1..134\n";
 
 my $i = 1;
 
@@ -541,3 +541,7 @@
 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";
+

==== //depot/perl/toke.c#403 (text) ====
Index: perl/toke.c
--- perl/toke.c.~1~     Sun Dec 30 22:15:05 2001
+++ perl/toke.c Sun Dec 30 22:15:05 2001
@@ -4904,7 +4904,7 @@
                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 @@
                    /* 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;
 
End of Patch.

Reply via email to