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