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