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