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