lib/warnings.pm

   1 # -*- buffer-read-only: t -*-
   2 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
   3 # This file is built by regen/warnings.pl.
   4 # Any changes made here will be lost!
   5
   6 package warnings;
   7
   8 our $VERSION = "1.48";
   9
  10 # Verify that we're called correctly so that warnings will work.
  11 # Can't use Carp, since Carp uses us!
  12 # String regexps because constant folding = smaller optree = less memory vs regexp literal
  13 # see also strict.pm.
  14 die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2]
  15     if __FILE__ !~ ( '(?x) \b     '.__PACKAGE__.'  \.pmc? \z' )
  16     && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' );
  17
  18 our %Offsets = (
  19     # Warnings Categories added in Perl 5.008
  20     'all'                               => 0,
  21     'closure'                           => 2,
  22     'deprecated'                        => 4,
  23     'exiting'                           => 6,
  24     'glob'                              => 8,
  25     'io'                                => 10,
  26     'closed'                            => 12,
  27     'exec'                              => 14,
  28     'layer'                             => 16,
  29     'newline'                           => 18,
  30     'pipe'                              => 20,
  31     'unopened'                          => 22,
  32     'misc'                              => 24,
  33     'numeric'                           => 26,
  34     'once'                              => 28,
  35     'overflow'                          => 30,
  36     'pack'                              => 32,
  37     'portable'                          => 34,
  38     'recursion'                         => 36,
  39     'redefine'                          => 38,
  40     'regexp'                            => 40,
  41     'severe'                            => 42,
  42     'debugging'                         => 44,
  43     'inplace'                           => 46,
  44     'internal'                          => 48,
  45     'malloc'                            => 50,
  46     'signal'                            => 52,
  47     'substr'                            => 54,
  48     'syntax'                            => 56,
  49     'ambiguous'                         => 58,
  50     'bareword'                          => 60,
  51     'digit'                             => 62,
  52     'parenthesis'                       => 64,
  53     'precedence'                        => 66,
  54     'printf'                            => 68,
  55     'prototype'                         => 70,
  56     'qw'                                => 72,
  57     'reserved'                          => 74,
  58     'semicolon'                         => 76,
  59     'taint'                             => 78,
  60     'threads'                           => 80,
  61     'uninitialized'                     => 82,
  62     'unpack'                            => 84,
  63     'untie'                             => 86,
  64     'utf8'                              => 88,
  65     'void'                              => 90,
  66
  67     # Warnings Categories added in Perl 5.011
  68     'imprecision'                       => 92,
  69     'illegalproto'                      => 94,
  70
  71     # Warnings Categories added in Perl 5.013
  72     'non_unicode'                       => 96,
  73     'nonchar'                           => 98,
  74     'surrogate'                         => 100,
  75
  76     # Warnings Categories added in Perl 5.017
  77     'experimental'                      => 102,
  78     'experimental::lexical_subs'        => 104,
  79     'experimental::regex_sets'          => 106,
  80     'experimental::smartmatch'          => 108,
  81
  82     # Warnings Categories added in Perl 5.019
  83     'experimental::postderef'           => 110,
  84     'experimental::signatures'          => 112,
  85     'syscalls'                          => 114,
  86
  87     # Warnings Categories added in Perl 5.021
  88     'experimental::bitwise'             => 116,
  89     'experimental::const_attr'          => 118,
  90     'experimental::re_strict'           => 120,
  91     'experimental::refaliasing'         => 122,
  92     'experimental::win32_perlio'        => 124,
  93     'locale'                            => 126,
  94     'missing'                           => 128,
  95     'redundant'                         => 130,
  96
  97     # Warnings Categories added in Perl 5.025
  98     'experimental::declared_refs'       => 132,
  99
 100     # Warnings Categories added in Perl 5.027
 101     'experimental::alpha_assertions'    => 134,
 102     'experimental::script_run'          => 136,
 103     'shadow'                            => 138,
 104
 105     # Warnings Categories added in Perl 5.029
 106     'experimental::private_use'         => 140,
 107     'experimental::uniprop_wildcards'   => 142,
 108     'experimental::vlb'                 => 144,
 109
 110     # Warnings Categories added in Perl 5.031
 111     'experimental::isa'                 => 146,
 112 );
 113
 114 our %Bits = (
 115     'all'                               => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..75]
 116     'ambiguous'                         => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
 117     'bareword'                          => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
 118     'closed'                            => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
 119     'closure'                           => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
 120     'debugging'                         => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
 121     'deprecated'                        => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
 122     'digit'                             => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
 123     'exec'                              => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
 124     'exiting'                           => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
 125     'experimental'                      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x51\x15\x50\x51\x05", # [51..56,58..62,66..68,70..73]
 126     'experimental::alpha_assertions'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [67]
 127     'experimental::bitwise'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [58]
 128     'experimental::const_attr'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [59]
 129     'experimental::declared_refs'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [66]
 130     'experimental::isa'                 => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [73]
 131     'experimental::lexical_subs'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [52]
 132     'experimental::postderef'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [55]
 133     'experimental::private_use'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [70]
 134     'experimental::re_strict'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [60]
 135     'experimental::refaliasing'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [61]
 136     'experimental::regex_sets'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [53]
 137     'experimental::script_run'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [68]
 138     'experimental::signatures'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [56]
 139     'experimental::smartmatch'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [54]
 140     'experimental::uniprop_wildcards'   => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [71]
 141     'experimental::vlb'                 => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [72]
 142     'experimental::win32_perlio'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [62]
 143     'glob'                              => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
 144     'illegalproto'                      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [47]
 145     'imprecision'                       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [46]
 146     'inplace'                           => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
 147     'internal'                          => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
 148     'io'                                => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [5..11,57]
 149     'layer'                             => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
 150     'locale'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [63]
 151     'malloc'                            => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
 152     'misc'                              => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
 153     'missing'                           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [64]
 154     'newline'                           => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
 155     'non_unicode'                       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [48]
 156     'nonchar'                           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [49]
 157     'numeric'                           => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
 158     'once'                              => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
 159     'overflow'                          => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
 160     'pack'                              => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
 161     'parenthesis'                       => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [32]
 162     'pipe'                              => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
 163     'portable'                          => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
 164     'precedence'                        => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [33]
 165     'printf'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [34]
 166     'prototype'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [35]
 167     'qw'                                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [36]
 168     'recursion'                         => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
 169     'redefine'                          => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
 170     'redundant'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [65]
 171     'regexp'                            => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
 172     'reserved'                          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [37]
 173     'semicolon'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [38]
 174     'severe'                            => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
 175     'shadow'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [69]
 176     'signal'                            => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
 177     'substr'                            => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
 178     'surrogate'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [50]
 179     'syntax'                            => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [28..38,47]
 180     'syscalls'                          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [57]
 181     'taint'                             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [39]
 182     'threads'                           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [40]
 183     'uninitialized'                     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [41]
 184     'unopened'                          => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
 185     'unpack'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [42]
 186     'untie'                             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [43]
 187     'utf8'                              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00\x00\x00\x00\x00\x00", # [44,48..50]
 188     'void'                              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [45]
 189 );
 190
 191 our %DeadBits = (
 192     'all'                               => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..75]
 193     'ambiguous'                         => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
 194     'bareword'                          => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
 195     'closed'                            => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
 196     'closure'                           => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
 197     'debugging'                         => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
 198     'deprecated'                        => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
 199     'digit'                             => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
 200     'exec'                              => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
 201     'exiting'                           => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
 202     'experimental'                      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\xa2\x2a\xa0\xa2\x0a", # [51..56,58..62,66..68,70..73]
 203     'experimental::alpha_assertions'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [67]
 204     'experimental::bitwise'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [58]
 205     'experimental::const_attr'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [59]
 206     'experimental::declared_refs'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [66]
 207     'experimental::isa'                 => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [73]
 208     'experimental::lexical_subs'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [52]
 209     'experimental::postderef'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [55]
 210     'experimental::private_use'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [70]
 211     'experimental::re_strict'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [60]
 212     'experimental::refaliasing'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [61]
 213     'experimental::regex_sets'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [53]
 214     'experimental::script_run'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [68]
 215     'experimental::signatures'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [56]
 216     'experimental::smartmatch'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [54]
 217     'experimental::uniprop_wildcards'   => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [71]
 218     'experimental::vlb'                 => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [72]
 219     'experimental::win32_perlio'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [62]
 220     'glob'                              => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
 221     'illegalproto'                      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [47]
 222     'imprecision'                       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [46]
 223     'inplace'                           => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
 224     'internal'                          => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
 225     'io'                                => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [5..11,57]
 226     'layer'                             => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
 227     'locale'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [63]
 228     'malloc'                            => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
 229     'misc'                              => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
 230     'missing'                           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [64]
 231     'newline'                           => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
 232     'non_unicode'                       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [48]
 233     'nonchar'                           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [49]
 234     'numeric'                           => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
 235     'once'                              => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
 236     'overflow'                          => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
 237     'pack'                              => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
 238     'parenthesis'                       => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [32]
 239     'pipe'                              => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
 240     'portable'                          => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
 241     'precedence'                        => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [33]
 242     'printf'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [34]
 243     'prototype'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [35]
 244     'qw'                                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [36]
 245     'recursion'                         => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
 246     'redefine'                          => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
 247     'redundant'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [65]
 248     'regexp'                            => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
 249     'reserved'                          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [37]
 250     'semicolon'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [38]
 251     'severe'                            => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
 252     'shadow'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [69]
 253     'signal'                            => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
 254     'substr'                            => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
 255     'surrogate'                         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [50]
 256     'syntax'                            => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [28..38,47]
 257     'syscalls'                          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [57]
 258     'taint'                             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [39]
 259     'threads'                           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [40]
 260     'uninitialized'                     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [41]
 261     'unopened'                          => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
 262     'unpack'                            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [42]
 263     'untie'                             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [43]
 264     'utf8'                              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00\x00\x00\x00\x00\x00", # [44,48..50]
 265     'void'                              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [45]
 266 );
 267
 268 # These are used by various things, including our own tests
 269 our $NONE                               =  "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
 270 our $DEFAULT                            =  "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x51\x55\x50\x51\x05"; # [2,4,22,23,25,52..56,58..63,66..68,70..73]
 271 our $LAST_BIT                           =  148 ;
 272 our $BYTES                              =  19 ;
 273
 274 sub Croaker
 275 {
 276     require Carp; # this initializes %CarpInternal
 277     local $Carp::CarpInternal{'warnings'};
 278     delete $Carp::CarpInternal{'warnings'};
 279     Carp::croak(@_);
 280 }
 281
 282 sub _expand_bits {
 283     my $bits = shift;
 284     my $want_len = ($LAST_BIT + 7) >> 3;
 285     my $len = length($bits);
 286     if ($len != $want_len) {
 287         if ($bits eq "") {
 288             $bits = "\x00" x $want_len;
 289         } elsif ($len > $want_len) {
 290             substr $bits, $want_len, $len-$want_len, "";
 291         } else {
 292             my $x = vec($bits, $Offsets{all} >> 1, 2);
 293             $x |= $x << 2;
 294             $x |= $x << 4;
 295             $bits .= chr($x) x ($want_len - $len);
 296         }
 297     }
 298     return $bits;
 299 }
 300
 301 sub _bits {
 302     my $mask = shift ;
 303     my $catmask ;
 304     my $fatal = 0 ;
 305     my $no_fatal = 0 ;
 306
 307     $mask = _expand_bits($mask);
 308     foreach my $word ( @_ ) {
 309         if ($word eq 'FATAL') {
 310             $fatal = 1;
 311             $no_fatal = 0;
 312         }
 313         elsif ($word eq 'NONFATAL') {
 314             $fatal = 0;
 315             $no_fatal = 1;
 316         }
 317         elsif ($catmask = $Bits{$word}) {
 318             $mask |= $catmask ;
 319             $mask |= $DeadBits{$word} if $fatal ;
 320             $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ;
 321         }
 322         else
 323           { Croaker("Unknown warnings category '$word'")}
 324     }
 325
 326     return $mask ;
 327 }
 328
 329 sub bits
 330 {
 331     # called from B::Deparse.pm
 332     push @_, 'all' unless @_ ;
 333     return _bits("", @_) ;
 334 }
 335
 336 sub import
 337 {
 338     shift;
 339
 340     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
 341
 342     # append 'all' when implied (empty import list or after a lone
 343     # "FATAL" or "NONFATAL")
 344     push @_, 'all'
 345         if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
 346
 347     ${^WARNING_BITS} = _bits($mask, @_);
 348 }
 349
 350 sub unimport
 351 {
 352     shift;
 353
 354     my $catmask ;
 355     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
 356
 357     # append 'all' when implied (empty import list or after a lone "FATAL")
 358     push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
 359
 360     $mask = _expand_bits($mask);
 361     foreach my $word ( @_ ) {
 362         if ($word eq 'FATAL') {
 363             next;
 364         }
 365         elsif ($catmask = $Bits{$word}) {
 366             $mask = ~(~$mask | $catmask | $DeadBits{$word});
 367         }
 368         else
 369           { Croaker("Unknown warnings category '$word'")}
 370     }
 371
 372     ${^WARNING_BITS} = $mask ;
 373 }
 374
 375 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
 376
 377 sub LEVEL () { 8 };
 378 sub MESSAGE () { 4 };
 379 sub FATAL () { 2 };
 380 sub NORMAL () { 1 };
 381
 382 sub __chk
 383 {
 384     my $category ;
 385     my $offset ;
 386     my $isobj = 0 ;
 387     my $wanted = shift;
 388     my $has_message = $wanted & MESSAGE;
 389     my $has_level   = $wanted & LEVEL  ;
 390
 391     if ($has_level) {
 392         if (@_ != ($has_message ? 3 : 2)) {
 393             my $sub = (caller 1)[3];
 394             my $syntax = $has_message
 395                 ? "category, level, 'message'"
 396                 : 'category, level';
 397             Croaker("Usage: $sub($syntax)");
 398         }
 399     }
 400     elsif (not @_ == 1 || @_ == ($has_message ? 2 : 0)) {
 401         my $sub = (caller 1)[3];
 402         my $syntax = $has_message ? "[category,] 'message'" : '[category]';
 403         Croaker("Usage: $sub($syntax)");
 404     }
 405
 406     my $message = pop if $has_message;
 407
 408     if (@_) {
 409         # check the category supplied.
 410         $category = shift ;
 411         if (my $type = ref $category) {
 412             Croaker("not an object")
 413                 if exists $builtin_type{$type};
 414             $category = $type;
 415             $isobj = 1 ;
 416         }
 417         $offset = $Offsets{$category};
 418         Croaker("Unknown warnings category '$category'")
 419             unless defined $offset;
 420     }
 421     else {
 422         $category = (caller(1))[0] ;
 423         $offset = $Offsets{$category};
 424         Croaker("package '$category' not registered for warnings")
 425             unless defined $offset ;
 426     }
 427
 428     my $i;
 429
 430     if ($isobj) {
 431         my $pkg;
 432         $i = 2;
 433         while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
 434             last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
 435         }
 436         $i -= 2 ;
 437     }
 438     elsif ($has_level) {
 439         $i = 2 + shift;
 440     }
 441     else {
 442         $i = _error_loc(); # see where Carp will allocate the error
 443     }
 444
 445     # Default to 0 if caller returns nothing.  Default to $DEFAULT if it
 446     # explicitly returns undef.
 447     my(@callers_bitmask) = (caller($i))[9] ;
 448     my $callers_bitmask =
 449          @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
 450     length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all};
 451
 452     my @results;
 453     foreach my $type (FATAL, NORMAL) {
 454         next unless $wanted & $type;
 455
 456         push @results, vec($callers_bitmask, $offset + $type - 1, 1);
 457     }
 458
 459     # &enabled and &fatal_enabled
 460     return $results[0] unless $has_message;
 461
 462     # &warnif, and the category is neither enabled as warning nor as fatal
 463     return if ($wanted & (NORMAL | FATAL | MESSAGE))
 464                       == (NORMAL | FATAL | MESSAGE)
 465         && !($results[0] || $results[1]);
 466
 467     # If we have an explicit level, bypass Carp.
 468     if ($has_level and @callers_bitmask) {
 469         # logic copied from util.c:mess_sv
 470         my $stuff = " at " . join " line ", (caller $i)[1,2];
 471         $stuff .= sprintf ", <%s> %s %d",
 472                            *${^LAST_FH}{NAME},
 473                            ($/ eq "\n" ? "line" : "chunk"), $.
 474             if $. && ${^LAST_FH};
 475         die "$message$stuff.\n" if $results[0];
 476         return warn "$message$stuff.\n";
 477     }
 478
 479     require Carp;
 480     Carp::croak($message) if $results[0];
 481     # will always get here for &warn. will only get here for &warnif if the
 482     # category is enabled
 483     Carp::carp($message);
 484 }
 485
 486 sub _mkMask
 487 {
 488     my ($bit) = @_;
 489     my $mask = "";
 490
 491     vec($mask, $bit, 1) = 1;
 492     return $mask;
 493 }
 494
 495 sub register_categories
 496 {
 497     my @names = @_;
 498
 499     for my $name (@names) {
 500         if (! defined $Bits{$name}) {
 501             $Offsets{$name}  = $LAST_BIT;
 502             $Bits{$name}     = _mkMask($LAST_BIT++);
 503             $DeadBits{$name} = _mkMask($LAST_BIT++);
 504             if (length($Bits{$name}) > length($Bits{all})) {
 505                 $Bits{all} .= "\x55";
 506                 $DeadBits{all} .= "\xaa";
 507             }
 508         }
 509     }
 510 }
 511
 512 sub _error_loc {
 513     require Carp;
 514     goto &Carp::short_error_loc; # don't introduce another stack frame
 515 }
 516
 517 sub enabled
 518 {
 519     return __chk(NORMAL, @_);
 520 }
 521
 522 sub fatal_enabled
 523 {
 524     return __chk(FATAL, @_);
 525 }
 526
 527 sub warn
 528 {
 529     return __chk(FATAL | MESSAGE, @_);
 530 }
 531
 532 sub warnif
 533 {
 534     return __chk(NORMAL | FATAL | MESSAGE, @_);
 535 }
 536
 537 sub enabled_at_level
 538 {
 539     return __chk(NORMAL | LEVEL, @_);
 540 }
 541
 542 sub fatal_enabled_at_level
 543 {
 544     return __chk(FATAL | LEVEL, @_);
 545 }
 546
 547 sub warn_at_level
 548 {
 549     return __chk(FATAL | MESSAGE | LEVEL, @_);
 550 }
 551
 552 sub warnif_at_level
 553 {
 554     return __chk(NORMAL | FATAL | MESSAGE | LEVEL, @_);
 555 }
 556
 557 # These are not part of any public interface, so we can delete them to save
 558 # space.
 559 delete @warnings::{qw(NORMAL FATAL MESSAGE LEVEL)};
 560
 561 1;
 562 __END__
 563
 564 =head1 NAME
 565
 566 warnings - Perl pragma to control optional warnings
 567
 568 =head1 SYNOPSIS
 569
 570     use warnings;
 571     no warnings;
 572
 573     use warnings "all";
 574     no warnings "all";
 575
 576     use warnings::register;
 577     if (warnings::enabled()) {
 578         warnings::warn("some warning");
 579     }
 580
 581     if (warnings::enabled("void")) {
 582         warnings::warn("void", "some warning");
 583     }
 584
 585     if (warnings::enabled($object)) {
 586         warnings::warn($object, "some warning");
 587     }
 588
 589     warnings::warnif("some warning");
 590     warnings::warnif("void", "some warning");
 591     warnings::warnif($object, "some warning");
 592
 593 =head1 DESCRIPTION
 594
 595 The C<warnings> pragma gives control over which warnings are enabled in
 596 which parts of a Perl program.  It's a more flexible alternative for
 597 both the command line flag B<-w> and the equivalent Perl variable,
 598 C<$^W>.
 599
 600 This pragma works just like the C<strict> pragma.
 601 This means that the scope of the warning pragma is limited to the
 602 enclosing block.  It also means that the pragma setting will not
 603 leak across files (via C<use>, C<require> or C<do>).  This allows
 604 authors to independently define the degree of warning checks that will
 605 be applied to their module.
 606
 607 By default, optional warnings are disabled, so any legacy code that
 608 doesn't attempt to control the warnings will work unchanged.
 609
 610 All warnings are enabled in a block by either of these:
 611
 612     use warnings;
 613     use warnings 'all';
 614
 615 Similarly all warnings are disabled in a block by either of these:
 616
 617     no warnings;
 618     no warnings 'all';
 619
 620 For example, consider the code below:
 621
 622     use warnings;
 623     my @x;
 624     {
 625         no warnings;
 626         my $y = @x[0];
 627     }
 628     my $z = @x[0];
 629
 630 The code in the enclosing block has warnings enabled, but the inner
 631 block has them disabled.  In this case that means the assignment to the
 632 scalar C<$z> will trip the C<"Scalar value @x[0] better written as $x[0]">
 633 warning, but the assignment to the scalar C<$y> will not.
 634
 635 =head2 Default Warnings and Optional Warnings
 636
 637 Before the introduction of lexical warnings, Perl had two classes of
 638 warnings: mandatory and optional.
 639
 640 As its name suggests, if your code tripped a mandatory warning, you
 641 would get a warning whether you wanted it or not.
 642 For example, the code below would always produce an C<"isn't numeric">
 643 warning about the "2:".
 644
 645     my $x = "2:" + 3;
 646
 647 With the introduction of lexical warnings, mandatory warnings now become
 648 I<default> warnings.  The difference is that although the previously
 649 mandatory warnings are still enabled by default, they can then be
 650 subsequently enabled or disabled with the lexical warning pragma.  For
 651 example, in the code below, an C<"isn't numeric"> warning will only
 652 be reported for the C<$x> variable.
 653
 654     my $x = "2:" + 3;
 655     no warnings;
 656     my $y = "2:" + 3;
 657
 658 Note that neither the B<-w> flag or the C<$^W> can be used to
 659 disable/enable default warnings.  They are still mandatory in this case.
 660
 661 =head2 What's wrong with B<-w> and C<$^W>
 662
 663 Although very useful, the big problem with using B<-w> on the command
 664 line to enable warnings is that it is all or nothing.  Take the typical
 665 scenario when you are writing a Perl program.  Parts of the code you
 666 will write yourself, but it's very likely that you will make use of
 667 pre-written Perl modules.  If you use the B<-w> flag in this case, you
 668 end up enabling warnings in pieces of code that you haven't written.
 669
 670 Similarly, using C<$^W> to either disable or enable blocks of code is
 671 fundamentally flawed.  For a start, say you want to disable warnings in
 672 a block of code.  You might expect this to be enough to do the trick:
 673
 674      {
 675          local ($^W) = 0;
 676          my $x =+ 2;
 677          my $y; chop $y;
 678      }
 679
 680 When this code is run with the B<-w> flag, a warning will be produced
 681 for the C<$x> line:  C<"Reversed += operator">.
 682
 683 The problem is that Perl has both compile-time and run-time warnings.  To
 684 disable compile-time warnings you need to rewrite the code like this:
 685
 686      {
 687          BEGIN { $^W = 0 }
 688          my $x =+ 2;
 689          my $y; chop $y;
 690      }
 691
 692 And note that unlike the first example, this will permanently set C<$^W>
 693 since it cannot both run during compile-time and be localized to a
 694 run-time block.
 695
 696 The other big problem with C<$^W> is the way you can inadvertently
 697 change the warning setting in unexpected places in your code.  For example,
 698 when the code below is run (without the B<-w> flag), the second call
 699 to C<doit> will trip a C<"Use of uninitialized value"> warning, whereas
 700 the first will not.
 701
 702     sub doit
 703     {
 704         my $y; chop $y;
 705     }
 706
 707     doit();
 708
 709     {
 710         local ($^W) = 1;
 711         doit()
 712     }
 713
 714 This is a side-effect of C<$^W> being dynamically scoped.
 715
 716 Lexical warnings get around these limitations by allowing finer control
 717 over where warnings can or can't be tripped.
 718
 719 =head2 Controlling Warnings from the Command Line
 720
 721 There are three Command Line flags that can be used to control when
 722 warnings are (or aren't) produced:
 723
 724 =over 5
 725
 726 =item B<-w>
 727 X<-w>
 728
 729 This is  the existing flag.  If the lexical warnings pragma is B<not>
 730 used in any of your code, or any of the modules that you use, this flag
 731 will enable warnings everywhere.  See L</Backward Compatibility> for
 732 details of how this flag interacts with lexical warnings.
 733
 734 =item B<-W>
 735 X<-W>
 736
 737 If the B<-W> flag is used on the command line, it will enable all warnings
 738 throughout the program regardless of whether warnings were disabled
 739 locally using C<no warnings> or C<$^W =0>.
 740 This includes all files that get
 741 included via C<use>, C<require> or C<do>.
 742 Think of it as the Perl equivalent of the "lint" command.
 743
 744 =item B<-X>
 745 X<-X>
 746
 747 Does the exact opposite to the B<-W> flag, i.e. it disables all warnings.
 748
 749 =back
 750
 751 =head2 Backward Compatibility
 752
 753 If you are used to working with a version of Perl prior to the
 754 introduction of lexically scoped warnings, or have code that uses both
 755 lexical warnings and C<$^W>, this section will describe how they interact.
 756
 757 How Lexical Warnings interact with B<-w>/C<$^W>:
 758
 759 =over 5
 760
 761 =item 1.
 762
 763 If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
 764 control warnings is used and neither C<$^W> nor the C<warnings> pragma
 765 are used, then default warnings will be enabled and optional warnings
 766 disabled.
 767 This means that legacy code that doesn't attempt to control the warnings
 768 will work unchanged.
 769
 770 =item 2.
 771
 772 The B<-w> flag just sets the global C<$^W> variable as in 5.005.  This
 773 means that any legacy code that currently relies on manipulating C<$^W>
 774 to control warning behavior will still work as is.
 775
 776 =item 3.
 777
 778 Apart from now being a boolean, the C<$^W> variable operates in exactly
 779 the same horrible uncontrolled global way, except that it cannot
 780 disable/enable default warnings.
 781
 782 =item 4.
 783
 784 If a piece of code is under the control of the C<warnings> pragma,
 785 both the C<$^W> variable and the B<-w> flag will be ignored for the
 786 scope of the lexical warning.
 787
 788 =item 5.
 789
 790 The only way to override a lexical warnings setting is with the B<-W>
 791 or B<-X> command line flags.
 792
 793 =back
 794
 795 The combined effect of 3 & 4 is that it will allow code which uses
 796 the C<warnings> pragma to control the warning behavior of $^W-type
 797 code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
 798
 799 =head2 Category Hierarchy
 800 X<warning, categories>
 801
 802 A hierarchy of "categories" have been defined to allow groups of warnings
 803 to be enabled/disabled in isolation.
 804
 805 The current hierarchy is:
 806
 807     all -+
 808          |
 809          +- closure
 810          |
 811          +- deprecated
 812          |
 813          +- exiting
 814          |
 815          +- experimental --+
 816          |                 |
 817          |                 +- experimental::alpha_assertions
 818          |                 |
 819          |                 +- experimental::bitwise
 820          |                 |
 821          |                 +- experimental::const_attr
 822          |                 |
 823          |                 +- experimental::declared_refs
 824          |                 |
 825          |                 +- experimental::isa
 826          |                 |
 827          |                 +- experimental::lexical_subs
 828          |                 |
 829          |                 +- experimental::postderef
 830          |                 |
 831          |                 +- experimental::private_use
 832          |                 |
 833          |                 +- experimental::re_strict
 834          |                 |
 835          |                 +- experimental::refaliasing
 836          |                 |
 837          |                 +- experimental::regex_sets
 838          |                 |
 839          |                 +- experimental::script_run
 840          |                 |
 841          |                 +- experimental::signatures
 842          |                 |
 843          |                 +- experimental::smartmatch
 844          |                 |
 845          |                 +- experimental::uniprop_wildcards
 846          |                 |
 847          |                 +- experimental::vlb
 848          |                 |
 849          |                 +- experimental::win32_perlio
 850          |
 851          +- glob
 852          |
 853          +- imprecision
 854          |
 855          +- io ------------+
 856          |                 |
 857          |                 +- closed
 858          |                 |
 859          |                 +- exec
 860          |                 |
 861          |                 +- layer
 862          |                 |
 863          |                 +- newline
 864          |                 |
 865          |                 +- pipe
 866          |                 |
 867          |                 +- syscalls
 868          |                 |
 869          |                 +- unopened
 870          |
 871          +- locale
 872          |
 873          +- misc
 874          |
 875          +- missing
 876          |
 877          +- numeric
 878          |
 879          +- once
 880          |
 881          +- overflow
 882          |
 883          +- pack
 884          |
 885          +- portable
 886          |
 887          +- recursion
 888          |
 889          +- redefine
 890          |
 891          +- redundant
 892          |
 893          +- regexp
 894          |
 895          +- severe --------+
 896          |                 |
 897          |                 +- debugging
 898          |                 |
 899          |                 +- inplace
 900          |                 |
 901          |                 +- internal
 902          |                 |
 903          |                 +- malloc
 904          |
 905          +- shadow
 906          |
 907          +- signal
 908          |
 909          +- substr
 910          |
 911          +- syntax --------+
 912          |                 |
 913          |                 +- ambiguous
 914          |                 |
 915          |                 +- bareword
 916          |                 |
 917          |                 +- digit
 918          |                 |
 919          |                 +- illegalproto
 920          |                 |
 921          |                 +- parenthesis
 922          |                 |
 923          |                 +- precedence
 924          |                 |
 925          |                 +- printf
 926          |                 |
 927          |                 +- prototype
 928          |                 |
 929          |                 +- qw
 930          |                 |
 931          |                 +- reserved
 932          |                 |
 933          |                 +- semicolon
 934          |
 935          +- taint
 936          |
 937          +- threads
 938          |
 939          +- uninitialized
 940          |
 941          +- unpack
 942          |
 943          +- untie
 944          |
 945          +- utf8 ----------+
 946          |                 |
 947          |                 +- non_unicode
 948          |                 |
 949          |                 +- nonchar
 950          |                 |
 951          |                 +- surrogate
 952          |
 953          +- void
 954
 955 Just like the "strict" pragma any of these categories can be combined
 956
 957     use warnings qw(void redefine);
 958     no warnings qw(io syntax untie);
 959
 960 Also like the "strict" pragma, if there is more than one instance of the
 961 C<warnings> pragma in a given scope the cumulative effect is additive.
 962
 963     use warnings qw(void); # only "void" warnings enabled
 964     ...
 965     use warnings qw(io);   # only "void" & "io" warnings enabled
 966     ...
 967     no warnings qw(void);  # only "io" warnings enabled
 968
 969 To determine which category a specific warning has been assigned to see
 970 L<perldiag>.
 971
 972 Note: Before Perl 5.8.0, the lexical warnings category "deprecated" was a
 973 sub-category of the "syntax" category.  It is now a top-level category
 974 in its own right.
 975
 976 Note: Before 5.21.0, the "missing" lexical warnings category was
 977 internally defined to be the same as the "uninitialized" category. It
 978 is now a top-level category in its own right.
 979
 980 =head2 Fatal Warnings
 981 X<warning, fatal>
 982
 983 The presence of the word "FATAL" in the category list will escalate
 984 warnings in those categories into fatal errors in that lexical scope.
 985
 986 B<NOTE:> FATAL warnings should be used with care, particularly
 987 C<< FATAL => 'all' >>.
 988
 989 Libraries using L<warnings::warn|/FUNCTIONS> for custom warning categories
 990 generally don't expect L<warnings::warn|/FUNCTIONS> to be fatal and can wind up
 991 in an unexpected state as a result.  For XS modules issuing categorized
 992 warnings, such unanticipated exceptions could also expose memory leak bugs.
 993
 994 Moreover, the Perl interpreter itself has had serious bugs involving
 995 fatalized warnings.  For a summary of resolved and unresolved problems as
 996 of January 2015, please see
 997 L<this perl5-porters post|http://www.nntp.perl.org/group/perl.perl5.porters/2015/01/msg225235.html>.
 998
 999 While some developers find fatalizing some warnings to be a useful
1000 defensive programming technique, using C<< FATAL => 'all' >> to fatalize
1001 all possible warning categories -- including custom ones -- is particularly
1002 risky.  Therefore, the use of C<< FATAL => 'all' >> is
1003 L<discouraged|perlpolicy/discouraged>.
1004
1005 The L<strictures|strictures/VERSION-2> module on CPAN offers one example of
1006 a warnings subset that the module's authors believe is relatively safe to
1007 fatalize.
1008
1009 B<NOTE:> users of FATAL warnings, especially those using
1010 C<< FATAL => 'all' >>, should be fully aware that they are risking future
1011 portability of their programs by doing so.  Perl makes absolutely no
1012 commitments to not introduce new warnings or warnings categories in the
1013 future; indeed, we explicitly reserve the right to do so.  Code that may
1014 not warn now may warn in a future release of Perl if the Perl5 development
1015 team deems it in the best interests of the community to do so.  Should code
1016 using FATAL warnings break due to the introduction of a new warning we will
1017 NOT consider it an incompatible change.  Users of FATAL warnings should
1018 take special caution during upgrades to check to see if their code triggers
1019 any new warnings and should pay particular attention to the fine print of
1020 the documentation of the features they use to ensure they do not exploit
1021 features that are documented as risky, deprecated, or unspecified, or where
1022 the documentation says "so don't do that", or anything with the same sense
1023 and spirit.  Use of such features in combination with FATAL warnings is
1024 ENTIRELY AT THE USER'S RISK.
1025
1026 The following documentation describes how to use FATAL warnings but the
1027 perl5 porters strongly recommend that you understand the risks before doing
1028 so, especially for library code intended for use by others, as there is no
1029 way for downstream users to change the choice of fatal categories.
1030
1031 In the code below, the use of C<time>, C<length>
1032 and C<join> can all produce a C<"Useless use of xxx in void context">
1033 warning.
1034
1035     use warnings;
1036
1037     time;
1038
1039     {
1040         use warnings FATAL => qw(void);
1041         length "abc";
1042     }
1043
1044     join "", 1,2,3;
1045
1046     print "done\n";
1047
1048 When run it produces this output
1049
1050     Useless use of time in void context at fatal line 3.
1051     Useless use of length in void context at fatal line 7.
1052
1053 The scope where C<length> is used has escalated the C<void> warnings
1054 category into a fatal error, so the program terminates immediately when it
1055 encounters the warning.
1056
1057 To explicitly turn off a "FATAL" warning you just disable the warning
1058 it is associated with.  So, for example, to disable the "void" warning
1059 in the example above, either of these will do the trick:
1060
1061     no warnings qw(void);
1062     no warnings FATAL => qw(void);
1063
1064 If you want to downgrade a warning that has been escalated into a fatal
1065 error back to a normal warning, you can use the "NONFATAL" keyword.  For
1066 example, the code below will promote all warnings into fatal errors,
1067 except for those in the "syntax" category.
1068
1069     use warnings FATAL => 'all', NONFATAL => 'syntax';
1070
1071 As of Perl 5.20, instead of C<< use warnings FATAL => 'all'; >> you can
1072 use:
1073
1074    use v5.20;       # Perl 5.20 or greater is required for the following
1075    use warnings 'FATAL';  # short form of "use warnings FATAL => 'all';"
1076
1077 If you want your program to be compatible with versions of Perl before
1078 5.20, you must use C<< use warnings FATAL => 'all'; >> instead.  (In
1079 previous versions of Perl, the behavior of the statements
1080 C<< use warnings 'FATAL'; >>, C<< use warnings 'NONFATAL'; >> and
1081 C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
1082 they included the C<< => 'all' >> portion.  As of 5.20, they do.)
1083
1084 =head2 Reporting Warnings from a Module
1085 X<warning, reporting> X<warning, registering>
1086
1087 The C<warnings> pragma provides a number of functions that are useful for
1088 module authors.  These are used when you want to report a module-specific
1089 warning to a calling module has enabled warnings via the C<warnings>
1090 pragma.
1091
1092 Consider the module C<MyMod::Abc> below.
1093
1094     package MyMod::Abc;
1095
1096     use warnings::register;
1097
1098     sub open {
1099         my $path = shift;
1100         if ($path !~ m#^/#) {
1101             warnings::warn("changing relative path to /var/abc")
1102                 if warnings::enabled();
1103             $path = "/var/abc/$path";
1104         }
1105     }
1106
1107     1;
1108
1109 The call to C<warnings::register> will create a new warnings category
1110 called "MyMod::Abc", i.e. the new category name matches the current
1111 package name.  The C<open> function in the module will display a warning
1112 message if it gets given a relative path as a parameter.  This warnings
1113 will only be displayed if the code that uses C<MyMod::Abc> has actually
1114 enabled them with the C<warnings> pragma like below.
1115
1116     use MyMod::Abc;
1117     use warnings 'MyMod::Abc';
1118     ...
1119     abc::open("../fred.txt");
1120
1121 It is also possible to test whether the pre-defined warnings categories are
1122 set in the calling module with the C<warnings::enabled> function.  Consider
1123 this snippet of code:
1124
1125     package MyMod::Abc;
1126
1127     sub open {
1128         if (warnings::enabled("deprecated")) {
1129             warnings::warn("deprecated",
1130                            "open is deprecated, use new instead");
1131         }
1132         new(@_);
1133     }
1134
1135     sub new
1136     ...
1137     1;
1138
1139 The function C<open> has been deprecated, so code has been included to
1140 display a warning message whenever the calling module has (at least) the
1141 "deprecated" warnings category enabled.  Something like this, say.
1142
1143     use warnings 'deprecated';
1144     use MyMod::Abc;
1145     ...
1146     MyMod::Abc::open($filename);
1147
1148 Either the C<warnings::warn> or C<warnings::warnif> function should be
1149 used to actually display the warnings message.  This is because they can
1150 make use of the feature that allows warnings to be escalated into fatal
1151 errors.  So in this case
1152
1153     use MyMod::Abc;
1154     use warnings FATAL => 'MyMod::Abc';
1155     ...
1156     MyMod::Abc::open('../fred.txt');
1157
1158 the C<warnings::warnif> function will detect this and die after
1159 displaying the warning message.
1160
1161 The three warnings functions, C<warnings::warn>, C<warnings::warnif>
1162 and C<warnings::enabled> can optionally take an object reference in place
1163 of a category name.  In this case the functions will use the class name
1164 of the object as the warnings category.
1165
1166 Consider this example:
1167
1168     package Original;
1169
1170     no warnings;
1171     use warnings::register;
1172
1173     sub new
1174     {
1175         my $class = shift;
1176         bless [], $class;
1177     }
1178
1179     sub check
1180     {
1181         my $self = shift;
1182         my $value = shift;
1183
1184         if ($value % 2 && warnings::enabled($self))
1185           { warnings::warn($self, "Odd numbers are unsafe") }
1186     }
1187
1188     sub doit
1189     {
1190         my $self = shift;
1191         my $value = shift;
1192         $self->check($value);
1193         # ...
1194     }
1195
1196     1;
1197
1198     package Derived;
1199
1200     use warnings::register;
1201     use Original;
1202     our @ISA = qw( Original );
1203     sub new
1204     {
1205         my $class = shift;
1206         bless [], $class;
1207     }
1208
1209
1210     1;
1211
1212 The code below makes use of both modules, but it only enables warnings from
1213 C<Derived>.
1214
1215     use Original;
1216     use Derived;
1217     use warnings 'Derived';
1218     my $x = Original->new();
1219     $x->doit(1);
1220     my $y = Derived->new();
1221     $x->doit(1);
1222
1223 When this code is run only the C<Derived> object, C<$y>, will generate
1224 a warning.
1225
1226     Odd numbers are unsafe at main.pl line 7
1227
1228 Notice also that the warning is reported at the line where the object is first
1229 used.
1230
1231 When registering new categories of warning, you can supply more names to
1232 warnings::register like this:
1233
1234     package MyModule;
1235     use warnings::register qw(format precision);
1236
1237     ...
1238
1239     warnings::warnif('MyModule::format', '...');
1240
1241 =head1 FUNCTIONS
1242
1243 Note: The functions with names ending in C<_at_level> were added in Perl
1244 5.28.
1245
1246 =over 4
1247
1248 =item use warnings::register
1249
1250 Creates a new warnings category with the same name as the package where
1251 the call to the pragma is used.
1252
1253 =item warnings::enabled()
1254
1255 Use the warnings category with the same name as the current package.
1256
1257 Return TRUE if that warnings category is enabled in the calling module.
1258 Otherwise returns FALSE.
1259
1260 =item warnings::enabled($category)
1261
1262 Return TRUE if the warnings category, C<$category>, is enabled in the
1263 calling module.
1264 Otherwise returns FALSE.
1265
1266 =item warnings::enabled($object)
1267
1268 Use the name of the class for the object reference, C<$object>, as the
1269 warnings category.
1270
1271 Return TRUE if that warnings category is enabled in the first scope
1272 where the object is used.
1273 Otherwise returns FALSE.
1274
1275 =item warnings::enabled_at_level($category, $level)
1276
1277 Like C<warnings::enabled>, but $level specifies the exact call frame, 0
1278 being the immediate caller.
1279
1280 =item warnings::fatal_enabled()
1281
1282 Return TRUE if the warnings category with the same name as the current
1283 package has been set to FATAL in the calling module.
1284 Otherwise returns FALSE.
1285
1286 =item warnings::fatal_enabled($category)
1287
1288 Return TRUE if the warnings category C<$category> has been set to FATAL in
1289 the calling module.
1290 Otherwise returns FALSE.
1291
1292 =item warnings::fatal_enabled($object)
1293
1294 Use the name of the class for the object reference, C<$object>, as the
1295 warnings category.
1296
1297 Return TRUE if that warnings category has been set to FATAL in the first
1298 scope where the object is used.
1299 Otherwise returns FALSE.
1300
1301 =item warnings::fatal_enabled_at_level($category, $level)
1302
1303 Like C<warnings::fatal_enabled>, but $level specifies the exact call frame,
1304 0 being the immediate caller.
1305
1306 =item warnings::warn($message)
1307
1308 Print C<$message> to STDERR.
1309
1310 Use the warnings category with the same name as the current package.
1311
1312 If that warnings category has been set to "FATAL" in the calling module
1313 then die. Otherwise return.
1314
1315 =item warnings::warn($category, $message)
1316
1317 Print C<$message> to STDERR.
1318
1319 If the warnings category, C<$category>, has been set to "FATAL" in the
1320 calling module then die. Otherwise return.
1321
1322 =item warnings::warn($object, $message)
1323
1324 Print C<$message> to STDERR.
1325
1326 Use the name of the class for the object reference, C<$object>, as the
1327 warnings category.
1328
1329 If that warnings category has been set to "FATAL" in the scope where C<$object>
1330 is first used then die. Otherwise return.
1331
1332 =item warnings::warn_at_level($category, $level, $message)
1333
1334 Like C<warnings::warn>, but $level specifies the exact call frame,
1335 0 being the immediate caller.
1336
1337 =item warnings::warnif($message)
1338
1339 Equivalent to:
1340
1341     if (warnings::enabled())
1342       { warnings::warn($message) }
1343
1344 =item warnings::warnif($category, $message)
1345
1346 Equivalent to:
1347
1348     if (warnings::enabled($category))
1349       { warnings::warn($category, $message) }
1350
1351 =item warnings::warnif($object, $message)
1352
1353 Equivalent to:
1354
1355     if (warnings::enabled($object))
1356       { warnings::warn($object, $message) }
1357
1358 =item warnings::warnif_at_level($category, $level, $message)
1359
1360 Like C<warnings::warnif>, but $level specifies the exact call frame,
1361 0 being the immediate caller.
1362
1363 =item warnings::register_categories(@names)
1364
1365 This registers warning categories for the given names and is primarily for
1366 use by the warnings::register pragma.
1367
1368 =back
1369
1370 See also L<perlmodlib/Pragmatic Modules> and L<perldiag>.
1371
1372 =cut
1373
1374 # ex: set ro: