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