summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/warnings.pm13
-rw-r--r--pod/perl5113delta.pod18
-rw-r--r--pod/perldiag.pod6
-rw-r--r--pod/perllexwarn.pod2
-rw-r--r--t/op/protowarn.t110
-rw-r--r--toke.c8
-rw-r--r--warnings.h1
-rw-r--r--warnings.pl1
8 files changed, 147 insertions, 12 deletions
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 771c98cba8..55837ba2cf 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -213,10 +213,11 @@ our %Offsets = (
# Warnings Categories added in Perl 5.011
'imprecision' => 92,
+ 'illegalproto' => 94,
);
our %Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -227,6 +228,7 @@ our %Bits = (
'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+ 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
@@ -254,7 +256,7 @@ our %Bits = (
'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
- 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40", # [28..38,47]
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
@@ -266,7 +268,7 @@ our %Bits = (
);
our %DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -277,6 +279,7 @@ our %DeadBits = (
'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+ 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]
'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
@@ -304,7 +307,7 @@ our %DeadBits = (
'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
- 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80", # [28..38,47]
'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
@@ -316,7 +319,7 @@ our %DeadBits = (
);
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
-$LAST_BIT = 94 ;
+$LAST_BIT = 96 ;
$BYTES = 12 ;
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
diff --git a/pod/perl5113delta.pod b/pod/perl5113delta.pod
index 77918e28e9..bdc7061117 100644
--- a/pod/perl5113delta.pod
+++ b/pod/perl5113delta.pod
@@ -443,6 +443,24 @@ C<sort> called recursively from within an active comparison subroutine no longer
=item *
+The two warnings :
+
+ Illegal character in prototype for %s : %s
+ Prototype after '%c' for %s : %s
+
+have been moved from the C<syntax> top-level warnings category into a new
+first-level category, C<illegalproto>. These two warnings are currently the
+only ones emitted during parsing of an invalid/illegal prototype, so one
+can now do
+
+ no warnings 'illegalproto';
+
+to suppress only those, but not other syntax-related warnings. Warnings where
+prototypes are changed, ignored, or not met are still in the C<prototype>
+category as before.
+
+=item *
+
C<split> now warns when called in void context
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 320e46ada4..665614851b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1926,8 +1926,8 @@ to your Perl administrator.
=item Illegal character in prototype for %s : %s
-(W syntax) An illegal character was found in a prototype declaration. Legal
-characters in prototypes are $, @, %, *, ;, [, ], &, and \.
+(W illegalproto) An illegal character was found in a prototype declaration.
+Legal characters in prototypes are $, @, %, *, ;, [, ], &, and \.
=item Illegal declaration of anonymous subroutine
@@ -3535,7 +3535,7 @@ in L<perlos2>.
=item Prototype after '%c' for %s : %s
-(W syntax) A character follows % or @ in a prototype. This is useless,
+(W illegalproto) A character follows % or @ in a prototype. This is useless,
since % and @ gobble the rest of the subroutine arguments.
=item Prototype mismatch: %s vs %s
diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod
index 1eb8b30087..45a7f5ffba 100644
--- a/pod/perllexwarn.pod
+++ b/pod/perllexwarn.pod
@@ -278,6 +278,8 @@ The current hierarchy is:
| |
| +- digit
| |
+ | +- illegalproto
+ | |
| +- parenthesis
| |
| +- precedence
diff --git a/t/op/protowarn.t b/t/op/protowarn.t
new file mode 100644
index 0000000000..0cf946afa5
--- /dev/null
+++ b/t/op/protowarn.t
@@ -0,0 +1,110 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = qw(. ../lib);
+}
+
+use strict;
+use warnings;
+
+BEGIN {
+ require 'test.pl';
+ plan( tests => 12 );
+}
+
+use vars qw{ @warnings $sub $warn };
+
+BEGIN {
+ $warn = 'Illegal character in prototype';
+}
+
+sub one_warning_ok {
+ cmp_ok(scalar(@warnings), '==', 1, 'One warning');
+ cmp_ok(substr($warnings[0],0,length($warn)),'eq',$warn,'warning message');
+ @warnings = ();
+}
+
+sub no_warnings_ok {
+ cmp_ok(scalar(@warnings), '==', 0, 'No warnings');
+ @warnings = ();
+}
+
+BEGIN {
+ $SIG{'__WARN__'} = sub { push @warnings, @_ };
+ $| = 1;
+}
+
+BEGIN { @warnings = () }
+
+$sub = sub (x) { };
+
+BEGIN {
+ one_warning_ok;
+}
+
+{
+ no warnings 'syntax';
+ $sub = sub (x) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'illegalproto';
+ $sub = sub (x) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'syntax';
+ use warnings 'illegalproto';
+ $sub = sub (x) { };
+}
+
+BEGIN {
+ one_warning_ok;
+}
+
+BEGIN {
+ $warn = q{Prototype after '@' for};
+}
+
+$sub = sub (@$) { };
+
+BEGIN {
+ one_warning_ok;
+}
+
+{
+ no warnings 'syntax';
+ $sub = sub (@$) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'illegalproto';
+ $sub = sub (@$) { };
+}
+
+BEGIN {
+ no_warnings_ok;
+}
+
+{
+ no warnings 'syntax';
+ use warnings 'illegalproto';
+ $sub = sub (@$) { };
+}
+
+BEGIN {
+ one_warning_ok;
+}
diff --git a/toke.c b/toke.c
index 13984390c7..deae6a5ceb 100644
--- a/toke.c
+++ b/toke.c
@@ -7348,7 +7348,7 @@ Perl_yylex(pTHX)
bool must_be_last = FALSE;
bool underscore = FALSE;
bool seen_underscore = FALSE;
- const bool warnsyntax = ckWARN(WARN_SYNTAX);
+ const bool warnillegalproto = ckWARN(WARN_ILLEGALPROTO);
s = scan_str(s,!!PL_madskills,FALSE);
if (!s)
@@ -7360,7 +7360,7 @@ Perl_yylex(pTHX)
if (!isSPACE(*p)) {
d[tmp++] = *p;
- if (warnsyntax) {
+ if (warnillegalproto) {
if (must_be_last)
proto_after_greedy_proto = TRUE;
if (!strchr("$@%*;[]&\\_", *p)) {
@@ -7393,11 +7393,11 @@ Perl_yylex(pTHX)
}
d[tmp] = '\0';
if (proto_after_greedy_proto)
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
"Prototype after '%c' for %"SVf" : %s",
greedy_proto, SVfARG(PL_subname), d);
if (bad_proto)
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+ Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
"Illegal character %sin prototype for %"SVf" : %s",
seen_underscore ? "after '_' " : "",
SVfARG(PL_subname), d);
diff --git a/warnings.h b/warnings.h
index 56b307912d..3ed9ecf56d 100644
--- a/warnings.h
+++ b/warnings.h
@@ -79,6 +79,7 @@
/* Warnings Categories added in Perl 5.011 */
#define WARN_IMPRECISION 46
+#define WARN_ILLEGALPROTO 47
#define WARNsize 12
#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125"
diff --git a/warnings.pl b/warnings.pl
index 835fd7c5e4..d3aca3d7c3 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -46,6 +46,7 @@ my $tree = {
'printf' => [ 5.008, DEFAULT_OFF],
'prototype' => [ 5.008, DEFAULT_OFF],
'qw' => [ 5.008, DEFAULT_OFF],
+ 'illegalproto' => [ 5.011, DEFAULT_OFF],
}],
'severe' => [ 5.008, {
'inplace' => [ 5.008, DEFAULT_ON],
View Lorry Controller Status