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