Skip to content

Commit

Permalink
Move prototype parsing related warnings from the 'syntax' top level w…
Browse files Browse the repository at this point in the history
…arnings 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.
  • Loading branch information
shadowcat-mst authored and rgs committed Jan 10, 2010
1 parent 9b5fd1d commit 197afce
Show file tree
Hide file tree
Showing 8 changed files with 147 additions and 12 deletions.
13 changes: 8 additions & 5 deletions lib/warnings.pm
Expand Up @@ -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]
Expand All @@ -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]
Expand Down Expand Up @@ -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]
Expand All @@ -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]
Expand All @@ -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]
Expand Down Expand Up @@ -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]
Expand All @@ -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 ;
Expand Down
18 changes: 18 additions & 0 deletions pod/perl5113delta.pod
Expand Up @@ -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


Expand Down
6 changes: 3 additions & 3 deletions pod/perldiag.pod
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions pod/perllexwarn.pod
Expand Up @@ -278,6 +278,8 @@ The current hierarchy is:
| |
| +- digit
| |
| +- illegalproto
| |
| +- parenthesis
| |
| +- precedence
Expand Down
110 changes: 110 additions & 0 deletions 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;
}
8 changes: 4 additions & 4 deletions toke.c
Expand Up @@ -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)
Expand All @@ -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)) {
Expand Down Expand Up @@ -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);
Expand Down
1 change: 1 addition & 0 deletions warnings.h
Expand Up @@ -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"
Expand Down
1 change: 1 addition & 0 deletions warnings.pl
Expand Up @@ -46,6 +46,7 @@ BEGIN
'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],
Expand Down

0 comments on commit 197afce

Please sign in to comment.