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