From: Sam Tregar <sam@tregar.com>
Date: Wed, 2 Jan 2002 14:04:26 +0000 (-0500)
Subject: Bad prototype detection changed from error to warning
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d37a953848a8a5e776efddc4a0591621effaf5f1;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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;