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