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