Bad prototype detection changed from error to warning

   Message-Id: <Pine.LNX.4.33.0201021400110.15420-200000@localhost.localdomain>

p4raw-id: //depot/perl@14025

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 7ec7492..11d298e 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1605,6 +1605,11 @@ when Perl was built using standard options.  For some reason, your
 version of Perl appears to have been built without this support.  Talk
 to your Perl administrator.
 
+=item Illegal character in prototype for %s : %s
+
+(S) An illegal character was found in a prototype declaration.  Legal
+characters in prototypes are $, @, %, *, ;, [, ], &, and \.
+
 =item Illegal division by zero
 
 (F) You tried to divide a number by 0.  Either something was wrong in
@@ -1871,10 +1876,10 @@ appear if components are not found, or are too long.  See
 
 =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.
+(F) You 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)
 

diff --git a/t/comp/proto.t b/t/comp/proto.t
index da3af28..32b1fad 100755 (executable)
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use strict;
 
-print "1..134\n";
+print "1..135\n";
 
 my $i = 1;
 
@@ -528,20 +528,29 @@ print "ok ", $i++, "\n";
     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";
+# check that obviously bad prototypes are getting warnings
+{
+  my $warn = "";
+  local $SIG{__WARN__} = sub { $warn .= join("",@_) };
+  
+  eval 'sub badproto (@bar) { 1; }';
+  print "not " unless $warn =~ /Illegal character in prototype for main::badproto : \@bar/;
+  print "ok ", $i++, "\n";
 
-eval 'sub badproto3 (&$bar$@) { 1; }';
-print "not " unless $@ =~ /^Malformed prototype for main::badproto3 : &\$bar\$\@/;
-print "ok ", $i++, "\n";
+  eval 'sub badproto2 (bar) { 1; }';
+  print "not " unless $warn =~ /Illegal character in prototype for main::badproto2 : bar/;
+  print "ok ", $i++, "\n";
+  
+  eval 'sub badproto3 (&$bar$@) { 1; }';
+  print "not " unless $warn =~ /Illegal character in prototype for main::badproto3 : &\$bar\$\@/;
+  print "ok ", $i++, "\n";
+  
+  eval 'sub badproto4 (@ $b ar) { 1; }';
+  print "not " unless $warn =~ /Illegal character in prototype for main::badproto4 : \@\$bar/;
+  print "ok ", $i++, "\n";
+}
 
-eval 'sub badproto4 (@ $b ar) { 1; }';
-print "not " unless $@ =~ /^Malformed prototype for main::badproto4 : \@\$bar/;
+# make sure whitespace in prototypes works
+eval "sub good (\$\t\$\n\$) { 1; }";
+print "not " if $@;
 print "ok ", $i++, "\n";
-

diff --git a/toke.c b/toke.c
index faa1eac..de71cee 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4957,15 +4957,17 @@ Perl_yylex(pTHX)
                    tmp = 0;
                    bad_proto = FALSE;
                    for (p = d; *p; ++p) {
-                       if (!strchr("$@%*;[]&\\ ", *p))
-                           bad_proto = TRUE;
-                       if (!isSPACE(*p))
+                       if (!isSPACE(*p)) {
                            d[tmp++] = *p;
+                           if (!strchr("$@%*;[]&\\", *p))
+                               bad_proto = TRUE;
+                       }
                    }
                    d[tmp] = '\0';
                    if (bad_proto)
-                       Perl_croak(aTHX_ "Malformed prototype for %s : %s",
-                                  SvPVX(PL_subname), d);
+                       Perl_warn(aTHX_
+                                 "Illegal character in prototype for %s : %s",
+                                 SvPVX(PL_subname), d);
                    SvCUR(PL_lex_stuff) = tmp;
                    have_proto = TRUE;