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