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