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