Change 34021 by [EMAIL PROTECTED] on 2008/06/08 08:57:00
Add a new warning, "Prototype after '%s'"
Based on:
Subject: Re: [perl #36673] sub foo(@$) {} should generate an error
From: =?ISO-8859-1?Q?Ren=E9e_B=E4cker?= <[EMAIL PROTECTED]>
Date: Mon, 26 May 2008 13:08:27 +0200
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/t/lib/warnings/toke#21 edit
... //depot/perl/toke.c#824 edit
Differences ...
==== //depot/perl/t/lib/warnings/toke#21 (text) ====
Index: perl/t/lib/warnings/toke
--- perl/t/lib/warnings/toke#20~30761~ 2007-03-26 07:21:39.000000000 -0700
+++ perl/t/lib/warnings/toke 2008-06-08 01:57:00.000000000 -0700
@@ -852,3 +852,26 @@
our $bar :unique;
EXPECT
Use of :unique is deprecated at - line 4.
+########
+# toke.c
+use warnings "syntax";
+sub proto_after_array(@$);
+sub proto_after_arref([EMAIL PROTECTED]);
+sub proto_after_arref2([EMAIL PROTECTED]);
+sub proto_after_arref3([EMAIL PROTECTED]);
+sub proto_after_hash(%$);
+sub proto_after_hashref(\%$);
+sub proto_after_hashref2(\[%$]);
+sub underscore_last_pos($_);
+sub underscore2($_;$);
+sub underscore_fail($_$);
+sub underscore_after_at(@_);
+no warnings "syntax";
+sub proto_after_array(@$);
+sub proto_after_hash(%$);
+sub underscore_fail($_$);
+EXPECT
+Prototype after '@' for main::proto_after_array : @$ at - line 3.
+Prototype after '%' for main::proto_after_hash : %$ at - line 7.
+Illegal character in prototype for main::underscore_fail : $_$ at - line 12.
+Prototype after '@' for main::underscore_after_at : @_ at - line 13.
==== //depot/perl/toke.c#824 (text) ====
Index: perl/toke.c
--- perl/toke.c#823~33874~ 2008-05-20 01:04:05.000000000 -0700
+++ perl/toke.c 2008-06-08 01:57:00.000000000 -0700
@@ -6744,6 +6744,11 @@
if (*s == '(') {
char *p;
bool bad_proto = FALSE;
+ bool in_brackets = FALSE;
+ char greedy_proto = ' ';
+ bool proto_after_greedy_proto = FALSE;
+ bool must_be_last = FALSE;
+ bool underscore = FALSE;
const bool warnsyntax = ckWARN(WARN_SYNTAX);
s = scan_str(s,!!PL_madskills,FALSE);
@@ -6755,11 +6760,43 @@
for (p = d; *p; ++p) {
if (!isSPACE(*p)) {
d[tmp++] = *p;
- if (warnsyntax && !strchr("[EMAIL
PROTECTED];[]&\\_", *p))
- bad_proto = TRUE;
+
+ if (warnsyntax) {
+ if (must_be_last)
+ proto_after_greedy_proto = TRUE;
+ if (!strchr("[EMAIL PROTECTED];[]&\\_", *p)) {
+ bad_proto = TRUE;
+ }
+ else {
+ if ( underscore ) {
+ if ( *p != ';' )
+ bad_proto = TRUE;
+ underscore = FALSE;
+ }
+ if ( *p == '[' ) {
+ in_brackets = TRUE;
+ }
+ else if ( *p == ']' ) {
+ in_brackets = FALSE;
+ }
+ else if ( (*p == '@' || *p == '%') &&
+ ( tmp < 2 || d[tmp-2] != '\\' ) &&
+ !in_brackets ) {
+ must_be_last = TRUE;
+ greedy_proto = *p;
+ }
+ else if ( *p == '_' ) {
+ underscore = TRUE;
+ }
+ }
+ }
}
}
d[tmp] = '\0';
+ if (proto_after_greedy_proto)
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ "Prototype after '%c' for %"SVf" : %s",
+ greedy_proto, SVfARG(PL_subname), d);
if (bad_proto)
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Illegal character in prototype for %"SVf"
: %s",
End of Patch.
