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