From 197afce1e759b5f0a1885a151064a83b27a7324e Mon Sep 17 00:00:00 2001 From: Matt S Trout Date: Thu, 10 Dec 2009 18:59:45 +0000 Subject: [PATCH] Move prototype parsing related warnings from the 'syntax' top level warnings category to a new 'illegalproto' subcategory. Two warnings can be emitted when parsing a prototype - Illegal character in prototype for %s : %s Prototype after '%c' for %s : %s The first one is emitted when any invalid character is found, the latter when further prototype-type stuff is found after a slurpy entry (i.e. valid character but in such a place as to be a no-op, and therefore likely a bug). These warnings are distinct from those emitted when a sub is overwritten by one with a different prototype, and when calls are made to subroutines with prototypes - those are in the pre-existing sub-category 'prototype'. Since modules such as signatures.pm and Web::Simple only need to disable the warnings during parsing, I chose to add a new category containing only these. Moving these warnings into the 'prototype' sub-category would have forced authors to disable more warnings than they intended, and the entire raison d'etre of this patch is to allow the specific warnings involved to be disabled. In order to maintain compatibility with existing code, the new location needed to be a sub-category of 'syntax' - this means that no warnings 'syntax'; will continue to work as expected - even in cases like Web::Simple where all subcategories extant prior to this patch are re-enabled (this is another reason why a move into the 'protoype' category would not achieve the desired goal). The category name 'illegalproto' was chosen because the most common warning to encounter is the "Illegal character" one, and therefore 'illegalproto' while minorly inaccurate by ignoring the (relatively recent and unknown) second warning is an easy name to spot on an initial skim of perllexwarn and will behave as expected by also disabling the case of an unusual prototype that happens to look like a normal one. This patch updates pod/perllexwarn.pod, perldiag.pod and perl5113delta.pod to document the new category, toke.c and warnings.pl to create and implement the new category, and a new test t/op/protowarn.t that verifies the new behaviour in a number of cases. It also includes the files generated by regen.pl that are found in the repo - notably warnings.h and lib/warnings.pm. --- lib/warnings.pm | 13 +++--- pod/perl5113delta.pod | 18 +++++++++ pod/perldiag.pod | 6 +-- pod/perllexwarn.pod | 2 + t/op/protowarn.t | 110 ++++++++++++++++++++++++++++++++++++++++++++++++++ toke.c | 8 ++-- warnings.h | 1 + warnings.pl | 1 + 8 files changed, 147 insertions(+), 12 deletions(-) create mode 100644 t/op/protowarn.t diff --git a/lib/warnings.pm b/lib/warnings.pm index 771c98c..55837ba 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 77918e2..bdc7061 100644 --- a/pod/perl5113delta.pod +++ b/pod/perl5113delta.pod @@ -443,6 +443,24 @@ C 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 top-level warnings category into a new +first-level category, C. 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 +category as before. + +=item * + C now warns when called in void context diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 320e46a..6656148 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. =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 1eb8b30..45a7f5f 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 0000000..0cf946a --- /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 1398439..deae6a5 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 56b3079..3ed9ecf 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 835fd7c..d3aca3d 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], -- 1.8.3.1