From 12bcd1a617c74d6ebf1dc3711b6a85be696dc9bb Mon Sep 17 00:00:00 2001 From: Paul Marquess Date: Mon, 4 Mar 2002 16:33:23 +0000 Subject: [PATCH] taint + deprecated warnings From: "Paul Marquess" Message-ID: p4raw-id: //depot/perl@15003 --- gv.c | 8 +-- lib/warnings.pm | 168 ++++++++++++++++++++++++------------------------- op.c | 32 +++++----- perly.c | 2 +- pod/perldelta.pod | 6 ++ pod/perllexwarn.pod | 9 ++- pp.c | 2 +- pp_sys.c | 10 +-- regcomp.c | 5 +- t/lib/warnings/regcomp | 1 + toke.c | 20 +++++- warnings.h | 111 ++++++++++++++++++++++---------- warnings.pl | 61 ++++++++++++++++-- 13 files changed, 278 insertions(+), 157 deletions(-) diff --git a/gv.c b/gv.c index aaf505c..70a9a12 100644 --- a/gv.c +++ b/gv.c @@ -482,9 +482,9 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) /* * Inheriting AUTOLOAD for non-methods works ... for now. */ - if (ckWARN(WARN_DEPRECATED) && !method && + if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash)) - Perl_warner(aTHX_ WARN_DEPRECATED, + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", HvNAME(stash), (int)len, name); @@ -918,8 +918,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) goto magicalize; case '#': case '*': - if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV) - Perl_warner(aTHX_ WARN_DEPRECATED, "Use of $%s is deprecated", name); + if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && len == 1 && sv_type == SVt_PV) + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of $%s is deprecated", name); /* FALL THROUGH */ case '[': case '^': diff --git a/lib/warnings.pm b/lib/warnings.pm index d0aa7b3..0b32815 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -131,34 +131,34 @@ use Carp ; %Offsets = ( 'all' => 0, 'closure' => 2, - 'exiting' => 4, - 'glob' => 6, - 'io' => 8, - 'closed' => 10, - 'exec' => 12, - 'newline' => 14, - 'pipe' => 16, - 'unopened' => 18, - 'misc' => 20, - 'numeric' => 22, - 'once' => 24, - 'overflow' => 26, - 'pack' => 28, - 'portable' => 30, - 'recursion' => 32, - 'redefine' => 34, - 'regexp' => 36, - 'severe' => 38, - 'debugging' => 40, - 'inplace' => 42, - 'internal' => 44, - 'malloc' => 46, - 'signal' => 48, - 'substr' => 50, - 'syntax' => 52, - 'ambiguous' => 54, - 'bareword' => 56, - 'deprecated' => 58, + 'deprecated' => 4, + 'exiting' => 6, + 'glob' => 8, + 'io' => 10, + 'closed' => 12, + 'exec' => 14, + 'newline' => 16, + 'pipe' => 18, + 'unopened' => 20, + 'misc' => 22, + 'numeric' => 24, + 'once' => 26, + 'overflow' => 28, + 'pack' => 30, + 'portable' => 32, + 'recursion' => 34, + 'redefine' => 36, + 'regexp' => 38, + 'severe' => 40, + 'debugging' => 42, + 'inplace' => 44, + 'internal' => 46, + 'malloc' => 48, + 'signal' => 50, + 'substr' => 52, + 'syntax' => 54, + 'ambiguous' => 56, + 'bareword' => 58, 'digit' => 60, 'parenthesis' => 62, 'precedence' => 64, @@ -178,45 +178,45 @@ use Carp ; %Bits = ( 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..44] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28] - 'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28] + 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29] + 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20] - 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29] + 'debugging' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21] + 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30] - 'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21] - 'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22] - 'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9] - 'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23] - 'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + '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] + 'inplace' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22] + 'internal' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23] + 'io' => "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24] + 'misc' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] + 'newline' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] + 'numeric' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12] + 'once' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13] + 'overflow' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + 'pack' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15] 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31] - 'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15] + 'pipe' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'portable' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16] 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32] 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33] 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34] 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35] - 'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16] - 'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17] - 'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18] + 'recursion' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17] + 'redefine' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18] + 'regexp' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19] 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36] 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37] - 'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23] - 'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24] - 'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25] - 'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37] + 'severe' => "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24] + 'signal' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25] + 'substr' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x05\x00\x00", # [27..37] 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38] 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39] - 'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'unopened' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40] 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41] 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42] @@ -226,45 +226,45 @@ use Carp ; %DeadBits = ( 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..44] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28] - 'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28] + 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29] + 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20] - 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29] + 'debugging' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21] + 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30] - 'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21] - 'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22] - 'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9] - 'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23] - 'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + '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] + 'inplace' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22] + 'internal' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23] + 'io' => "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24] + 'misc' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] + 'newline' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] + 'numeric' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12] + 'once' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13] + 'overflow' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + 'pack' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15] 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31] - 'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15] + 'pipe' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'portable' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16] 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32] 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33] 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34] 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35] - 'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16] - 'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17] - 'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18] + 'recursion' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17] + 'redefine' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18] + 'regexp' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19] 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36] 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37] - 'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23] - 'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24] - 'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25] - 'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37] + 'severe' => "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24] + 'signal' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25] + 'substr' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x0a\x00\x00", # [27..37] 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38] 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39] - 'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'unopened' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40] 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41] 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42] diff --git a/op.c b/op.c index 9b944c3..b0d4006 100644 --- a/op.c +++ b/op.c @@ -1027,7 +1027,7 @@ Perl_scalar(pTHX_ OP *o) case OP_SPLIT: if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { if (!kPMOP->op_pmreplroot) - deprecate("implicit split to @_"); + deprecate_old("implicit split to @_"); } /* FALL THROUGH */ case OP_MATCH: @@ -1274,7 +1274,7 @@ Perl_scalarvoid(pTHX_ OP *o) case OP_SPLIT: if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { if (!kPMOP->op_pmreplroot) - deprecate("implicit split to @_"); + deprecate_old("implicit split to @_"); } break; } @@ -3355,7 +3355,7 @@ Perl_package(pTHX_ OP *o) op_free(o); } else { - deprecate("\"package\" with no arguments"); + deprecate_old("\"package\" with no arguments"); sv_setpv(PL_curstname,""); PL_curstash = Nullhv; } @@ -5427,8 +5427,8 @@ Perl_newAVREF(pTHX_ OP *o) return o; } else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV) - && ckWARN(WARN_DEPRECATED)) { - Perl_warner(aTHX_ WARN_DEPRECATED, + && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) { + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Using an array as a reference is deprecated"); } return newUNOP(OP_RV2AV, 0, scalar(o)); @@ -5451,8 +5451,8 @@ Perl_newHVREF(pTHX_ OP *o) return o; } else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV) - && ckWARN(WARN_DEPRECATED)) { - Perl_warner(aTHX_ WARN_DEPRECATED, + && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) { + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Using a hash as a reference is deprecated"); } return newUNOP(OP_RV2HV, 0, scalar(o)); @@ -5913,8 +5913,8 @@ Perl_ck_fun(pTHX_ OP *o) char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVAV) )); - if (ckWARN(WARN_DEPRECATED)) - Perl_warner(aTHX_ WARN_DEPRECATED, + if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Array @%s missing the @ in argument %"IVdf" of %s()", name, (IV)numargs, PL_op_desc[type]); op_free(kid); @@ -5933,8 +5933,8 @@ Perl_ck_fun(pTHX_ OP *o) char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVHV) )); - if (ckWARN(WARN_DEPRECATED)) - Perl_warner(aTHX_ WARN_DEPRECATED, + if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Hash %%%s missing the %% in argument %"IVdf" of %s()", name, (IV)numargs, PL_op_desc[type]); op_free(kid); @@ -6191,7 +6191,7 @@ Perl_ck_lfun(pTHX_ OP *o) OP * Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ { - if ((o->op_flags & OPf_KIDS) && ckWARN(WARN_DEPRECATED)) { + if ((o->op_flags & OPf_KIDS) && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) { switch (cUNOPo->op_first->op_type) { case OP_RV2AV: /* This is needed for @@ -6201,9 +6201,9 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ break; /* Globals via GV can be undef */ case OP_PADAV: case OP_AASSIGN: /* Is this a good idea? */ - Perl_warner(aTHX_ WARN_DEPRECATED, + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "defined(@array) is deprecated"); - Perl_warner(aTHX_ WARN_DEPRECATED, + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "\t(Maybe you should just omit the defined()?)\n"); break; case OP_RV2HV: @@ -6213,9 +6213,9 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ */ break; /* Globals via GV can be undef */ case OP_PADHV: - Perl_warner(aTHX_ WARN_DEPRECATED, + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "defined(%%hash) is deprecated"); - Perl_warner(aTHX_ WARN_DEPRECATED, + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "\t(Maybe you should just omit the defined()?)\n"); break; default: diff --git a/perly.c b/perly.c index 2d4d79e..9fd86d3 100644 --- a/perly.c +++ b/perly.c @@ -9,7 +9,7 @@ #ifdef EBCDIC #undef YYDEBUG #endif -#define dep() deprecate("\"do\" to call subroutines") +#define dep() deprecate_old("\"do\" to call subroutines") /* stuff included here to make perly_c.diff apply better */ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 181f234..7a30b1c 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2280,6 +2280,12 @@ winsock handle leak fixed. =item * +The lexical warnings category "deprecated" is no longer a sub-category +of the "syntax" category. It is now a top-level category in its own +right. + +=item * + All regular expression compilation error messages are now hopefully easier to understand both because the error message now comes before the failed regex and because the point of failure is now clearly diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod index cd76f3a..2549256 100644 --- a/pod/perllexwarn.pod +++ b/pod/perllexwarn.pod @@ -209,6 +209,8 @@ The current hierarchy is: | +- closure | + +- deprecated + | +- exiting | +- glob @@ -263,8 +265,6 @@ The current hierarchy is: | | | +- bareword | | - | +- deprecated - | | | +- digit | | | +- parenthesis @@ -312,6 +312,11 @@ C pragma in a given scope the cumulative effect is additive. To determine which category a specific warning has been assigned to see L. +Note: In Perl 5.6.1, the lexical warnings category "deprecated" was a +sub-category of the "syntax" category. It is now a top-level category +in its own right. + + =head2 Fatal Warnings The presence of the word "FATAL" in the category list will escalate any diff --git a/pp.c b/pp.c index 488c2e4..2d155eb 100644 --- a/pp.c +++ b/pp.c @@ -555,7 +555,7 @@ PP(pp_gelem) case 'F': if (strEQ(elem, "FILEHANDLE")) { /* finally deprecated in 5.8.0 */ - deprecate("*glob{FILEHANDLE}"); + deprecate_old("*glob{FILEHANDLE}"); tmpRef = (SV*)GvIOp(gv); } else diff --git a/pp_sys.c b/pp_sys.c index 51afe1d..e44ab1c 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -3422,7 +3422,7 @@ PP(pp_chdir) ) { if( MAXARG == 1 ) - deprecate("chdir('') or chdir(undef) as chdir()"); + deprecate_old("chdir('') or chdir(undef) as chdir()"); tmps = SvPV(*svp, n_a); } else { @@ -4043,8 +4043,8 @@ PP(pp_system) if (SP - MARK == 1) { TAINT_PROPER("system"); } - else if (ckWARN(WARN_TAINT)) { - Perl_warner(aTHX_ WARN_TAINT, + else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) { + Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED), "Use of tainted arguments in %s is deprecated", "system"); } } @@ -4167,8 +4167,8 @@ PP(pp_exec) if (SP - MARK == 1) { TAINT_PROPER("exec"); } - else if (ckWARN(WARN_TAINT)) { - Perl_warner(aTHX_ WARN_TAINT, + else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) { + Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED), "Use of tainted arguments in %s is deprecated", "exec"); } } diff --git a/regcomp.c b/regcomp.c index 4bfef22..42588ff 100644 --- a/regcomp.c +++ b/regcomp.c @@ -392,8 +392,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define vWARNdep(loc,m) \ STMT_START { \ IV offset = loc - RExC_precomp; \ - int warn_cat = ckWARN(WARN_REGEXP) ? WARN_REGEXP : WARN_DEPRECATED; \ - Perl_warner(aTHX_ warn_cat, "%s" REPORT_LOCATION,\ + Perl_warner(aTHX_ packWARN3(WARN_DEPRECATED, WARN_REGEXP, WARN_SYNTAX), "%s" REPORT_LOCATION,\ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END \ @@ -2163,7 +2162,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) *flagp = TRYAGAIN; return NULL; case 'p': /* (?p...) */ - if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP)) + if (SIZE_ONLY && ckWARN3(WARN_DEPRECATED, WARN_REGEXP, WARN_SYNTAX)) vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})"); /* FALL THROUGH*/ case '?': /* (??...) */ diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp index b9cbecc..db44eca 100644 --- a/t/lib/warnings/regcomp +++ b/t/lib/warnings/regcomp @@ -183,6 +183,7 @@ $a =~ /(?p{'x'})/ ; use warnings; no warnings 'deprecated' ; no warnings 'regexp' ; +no warnings 'syntax' ; $a =~ /(?p{'x'})/ ; EXPECT (?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4. diff --git a/toke.c b/toke.c index 6e457c2..168a48a 100644 --- a/toke.c +++ b/toke.c @@ -319,6 +319,22 @@ Perl_deprecate(pTHX_ char *s) Perl_warner(aTHX_ WARN_DEPRECATED, "Use of %s is deprecated", s); } +void +Perl_deprecate_old(pTHX_ char *s) +{ + /* This function should NOT be called for any new deprecated warnings */ + /* Use Perl_deprecate instead */ + /* */ + /* It is here to maintain backward compatibility with the pre-5.8 */ + /* warnings category hierarchy. The "deprecated" category used to */ + /* live under the "syntax" category. It is now a top-level category */ + /* in its own right. */ + + if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + "Use of %s is deprecated", s); +} + /* * depcom * Deprecate a comma-less variable list. @@ -327,7 +343,7 @@ Perl_deprecate(pTHX_ char *s) STATIC void S_depcom(pTHX) { - deprecate("comma-less variable list"); + deprecate_old("comma-less variable list"); } /* @@ -6445,7 +6461,7 @@ S_scan_heredoc(pTHX_ register char *s) else term = '"'; if (!isALNUM_lazy_if(s,UTF)) - deprecate("bare << to mean <<\"\""); + deprecate_old("bare << to mean <<\"\""); for (; isALNUM_lazy_if(s,UTF); s++) { if (d < e) *d++ = *s; diff --git a/warnings.h b/warnings.h index d173b8d..0649c7e 100644 --- a/warnings.h +++ b/warnings.h @@ -24,34 +24,34 @@ (x) == pWARN_NONE) #define WARN_ALL 0 #define WARN_CLOSURE 1 -#define WARN_EXITING 2 -#define WARN_GLOB 3 -#define WARN_IO 4 -#define WARN_CLOSED 5 -#define WARN_EXEC 6 -#define WARN_NEWLINE 7 -#define WARN_PIPE 8 -#define WARN_UNOPENED 9 -#define WARN_MISC 10 -#define WARN_NUMERIC 11 -#define WARN_ONCE 12 -#define WARN_OVERFLOW 13 -#define WARN_PACK 14 -#define WARN_PORTABLE 15 -#define WARN_RECURSION 16 -#define WARN_REDEFINE 17 -#define WARN_REGEXP 18 -#define WARN_SEVERE 19 -#define WARN_DEBUGGING 20 -#define WARN_INPLACE 21 -#define WARN_INTERNAL 22 -#define WARN_MALLOC 23 -#define WARN_SIGNAL 24 -#define WARN_SUBSTR 25 -#define WARN_SYNTAX 26 -#define WARN_AMBIGUOUS 27 -#define WARN_BAREWORD 28 -#define WARN_DEPRECATED 29 +#define WARN_DEPRECATED 2 +#define WARN_EXITING 3 +#define WARN_GLOB 4 +#define WARN_IO 5 +#define WARN_CLOSED 6 +#define WARN_EXEC 7 +#define WARN_NEWLINE 8 +#define WARN_PIPE 9 +#define WARN_UNOPENED 10 +#define WARN_MISC 11 +#define WARN_NUMERIC 12 +#define WARN_ONCE 13 +#define WARN_OVERFLOW 14 +#define WARN_PACK 15 +#define WARN_PORTABLE 16 +#define WARN_RECURSION 17 +#define WARN_REDEFINE 18 +#define WARN_REGEXP 19 +#define WARN_SEVERE 20 +#define WARN_DEBUGGING 21 +#define WARN_INPLACE 22 +#define WARN_INTERNAL 23 +#define WARN_MALLOC 24 +#define WARN_SIGNAL 25 +#define WARN_SUBSTR 26 +#define WARN_SYNTAX 27 +#define WARN_AMBIGUOUS 28 +#define WARN_BAREWORD 29 #define WARN_DIGIT 30 #define WARN_PARENTHESIS 31 #define WARN_PRECEDENCE 32 @@ -79,11 +79,6 @@ #define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x))) #define isWARNf_on(c,x) (IsSet(SvPVX(c), 2*(x)+1)) -#define ckDEAD(x) \ - ( ! specialWARN(PL_curcop->cop_warnings) && \ - ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \ - isWARNf_on(PL_curcop->cop_warnings, x))) - #define ckWARN(x) \ ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ (PL_curcop->cop_warnings == pWARN_ALL || \ @@ -97,6 +92,23 @@ isWARN_on(PL_curcop->cop_warnings, y) ) ) \ || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) +#define ckWARN3(x,y,z) \ + ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ + (PL_curcop->cop_warnings == pWARN_ALL || \ + isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) ) ) \ + || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) + +#define ckWARN4(x,y,z,t) \ + ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ + (PL_curcop->cop_warnings == pWARN_ALL || \ + isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) || \ + isWARN_on(PL_curcop->cop_warnings, t) ) ) \ + || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) + #define ckWARN_d(x) \ (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ (PL_curcop->cop_warnings != pWARN_NONE && \ @@ -108,5 +120,38 @@ (isWARN_on(PL_curcop->cop_warnings, x) || \ isWARN_on(PL_curcop->cop_warnings, y) ) ) ) +#define ckWARN3_d(x,y,z) \ + (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ + (PL_curcop->cop_warnings != pWARN_NONE && \ + (isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) ) ) ) + +#define ckWARN4_d(x,y,z,t) \ + (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ + (PL_curcop->cop_warnings != pWARN_NONE && \ + (isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) || \ + isWARN_on(PL_curcop->cop_warnings, t) ) ) ) + +#define packWARN(a) (a ) +#define packWARN2(a,b) ((a) | (b)<<8 ) +#define packWARN3(a,b,c) ((a) | (b)<<8 | (c) <<16 ) +#define packWARN4(a,b,c,d) ((a) | (b)<<8 | (c) <<16 | (d) <<24) + +#define unpackWARN1(x) ((x) & 0xFF) +#define unpackWARN2(x) (((x) >>8) & 0xFF) +#define unpackWARN3(x) (((x) >>16) & 0xFF) +#define unpackWARN4(x) (((x) >>24) & 0xFF) + +#define ckDEAD(x) \ + ( ! specialWARN(PL_curcop->cop_warnings) && \ + ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x)))) + /* end of file warnings.h */ diff --git a/warnings.pl b/warnings.pl index f69c803..9a13cf0 100644 --- a/warnings.pl +++ b/warnings.pl @@ -27,7 +27,6 @@ my $tree = { 'reserved' => DEFAULT_OFF, 'digit' => DEFAULT_OFF, 'parenthesis' => DEFAULT_OFF, - 'deprecated' => DEFAULT_OFF, 'printf' => DEFAULT_OFF, 'prototype' => DEFAULT_OFF, 'qw' => DEFAULT_OFF, @@ -37,6 +36,7 @@ my $tree = { 'debugging' => DEFAULT_ON, 'malloc' => DEFAULT_ON, }, + 'deprecated' => DEFAULT_OFF, 'void' => DEFAULT_OFF, 'recursion' => DEFAULT_OFF, 'redefine' => DEFAULT_OFF, @@ -223,6 +223,10 @@ $index = $offset ; #@{ $list{"all"} } = walk ($tree) ; walk ($tree) ; +die < 255 ; +Too many warnings categories -- max is 255 + rewrite packWARN* & unpackWARN* macros +EOM $index *= 2 ; my $warn_size = int($index / 8) + ($index % 8 != 0) ; @@ -249,11 +253,6 @@ print WARN <<'EOM'; #define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x))) #define isWARNf_on(c,x) (IsSet(SvPVX(c), 2*(x)+1)) -#define ckDEAD(x) \ - ( ! specialWARN(PL_curcop->cop_warnings) && \ - ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \ - isWARNf_on(PL_curcop->cop_warnings, x))) - #define ckWARN(x) \ ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ (PL_curcop->cop_warnings == pWARN_ALL || \ @@ -267,6 +266,23 @@ print WARN <<'EOM'; isWARN_on(PL_curcop->cop_warnings, y) ) ) \ || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) +#define ckWARN3(x,y,z) \ + ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ + (PL_curcop->cop_warnings == pWARN_ALL || \ + isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) ) ) \ + || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) + +#define ckWARN4(x,y,z,t) \ + ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE && \ + (PL_curcop->cop_warnings == pWARN_ALL || \ + isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) || \ + isWARN_on(PL_curcop->cop_warnings, t) ) ) \ + || (isLEXWARN_off && PL_dowarn & G_WARN_ON) ) + #define ckWARN_d(x) \ (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ (PL_curcop->cop_warnings != pWARN_NONE && \ @@ -278,6 +294,39 @@ print WARN <<'EOM'; (isWARN_on(PL_curcop->cop_warnings, x) || \ isWARN_on(PL_curcop->cop_warnings, y) ) ) ) +#define ckWARN3_d(x,y,z) \ + (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ + (PL_curcop->cop_warnings != pWARN_NONE && \ + (isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) ) ) ) + +#define ckWARN4_d(x,y,z,t) \ + (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL || \ + (PL_curcop->cop_warnings != pWARN_NONE && \ + (isWARN_on(PL_curcop->cop_warnings, x) || \ + isWARN_on(PL_curcop->cop_warnings, y) || \ + isWARN_on(PL_curcop->cop_warnings, z) || \ + isWARN_on(PL_curcop->cop_warnings, t) ) ) ) + +#define packWARN(a) (a ) +#define packWARN2(a,b) ((a) | (b)<<8 ) +#define packWARN3(a,b,c) ((a) | (b)<<8 | (c) <<16 ) +#define packWARN4(a,b,c,d) ((a) | (b)<<8 | (c) <<16 | (d) <<24) + +#define unpackWARN1(x) ((x) & 0xFF) +#define unpackWARN2(x) (((x) >>8) & 0xFF) +#define unpackWARN3(x) (((x) >>16) & 0xFF) +#define unpackWARN4(x) (((x) >>24) & 0xFF) + +#define ckDEAD(x) \ + ( ! specialWARN(PL_curcop->cop_warnings) && \ + ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x)))) + /* end of file warnings.h */ EOM -- 2.7.4