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