Change 13971: [PATCH] Basic bad prototype detection

[Jarkko Hietaniemi]

Change 13971 by jhi@alpha on 2001/12/31 04:05:46

        Subject: [PATCH] Basic bad prototype detection
        From: Sam Tregar <[EMAIL PROTECTED]> 
        Date: Sun, 30 Dec 2001 19:57:55 -0500 (EST) 
        Message-ID: <[EMAIL PROTECTED]>

Affected files ...

.... //depot/perl/pod/perldiag.pod#252 edit
.... //depot/perl/t/comp/proto.t#31 edit
.... //depot/perl/toke.c#402 edit

Differences ...

==== //depot/perl/pod/perldiag.pod#252 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod.~1~   Sun Dec 30 21:15:05 2001
+++ perl/pod/perldiag.pod       Sun Dec 30 21:15:05 2001
@@ -1869,6 +1869,13 @@
 appear if components are not found, or are too long.  See
 "PERLLIB_PREFIX" in L<perlos2>.
 
+=item Malformed prototype for %s: %s
+
+(F) You declared or tried to use a function with a malformed
+prototype.  The syntax of function prototypes is given a brief
+compile-time check for obvious errors like invalid characters.  A more
+rigorous check is run when the function is called.
+
 =item Malformed UTF-8 character (%s)
 
 Perl detected something that didn't comply with UTF-8 encoding rules.

==== //depot/perl/t/comp/proto.t#31 (xtext) ====
Index: perl/t/comp/proto.t
--- perl/t/comp/proto.t.~1~     Sun Dec 30 21:15:05 2001
+++ perl/t/comp/proto.t Sun Dec 30 21:15:05 2001
@@ -16,7 +16,7 @@
 
 use strict;
 
-print "1..130\n";
+print "1..133\n";
 
 my $i = 1;
 
@@ -527,3 +527,17 @@
     print "not " unless myref(*myglob)  =~ /^GLOB\(/;
     print "ok ", $i++, "\n";
 }
+
+# check that obviously bad prototypes are getting rejected
+eval 'sub badproto (@bar) { 1; }';
+print "not " unless $@ =~ /^Malformed prototype for main::badproto : \@bar/;
+print "ok ", $i++, "\n";
+
+eval 'sub badproto2 (bar) { 1; }';
+print "not " unless $@ =~ /^Malformed prototype for main::badproto2 : bar/;
+print "ok ", $i++, "\n";
+
+eval 'sub badproto3 (&$bar$@) { 1; }';
+print "not " unless $@ =~ /^Malformed prototype for main::badproto3 : &\$bar\$\@/;
+print "ok ", $i++, "\n";
+

==== //depot/perl/toke.c#402 (text) ====
Index: perl/toke.c
--- perl/toke.c.~1~     Sun Dec 30 21:15:05 2001
+++ perl/toke.c Sun Dec 30 21:15:05 2001
@@ -4952,10 +4952,13 @@
                    s = scan_str(s,FALSE,FALSE);
                    if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
-                   /* strip spaces */
+                   /* strip spaces and check for bad characters */
                    d = SvPVX(PL_lex_stuff);
                    tmp = 0;
                    for (p = d; *p; ++p) {
+                       if (!strchr("$@%*;[]&\\ ", *p))
+                           Perl_croak(aTHX_ "Malformed prototype for %s : %s",
+                                      SvPVX(PL_subname), d);
                        if (!isSPACE(*p))
                            d[tmp++] = *p;
                    }
End of Patch.