taint + deprecated warnings

From: "Paul Marquess" <paul_marquess@yahoo.co.uk>
Message-ID: <AIEAJICLCBDNAAOLLOKLCEKGDOAA.paul_marquess@yahoo.co.uk>

p4raw-id: //depot/perl@15003

diff --git a/gv.c b/gv.c
index aaf505c..70a9a12 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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,"<none>");
        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 (file)
--- 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 (file)
--- 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 (file)
--- 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<warnings> pragma in a given scope the cumulative effect is additive.
 To determine which category a specific warning has been assigned to see
 L<perldiag>.
 
+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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 <<EOM if $index > 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