This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Typo in pp_complement().
[perl5.git] / lib / warnings.pm
CommitLineData
599cee73 1
4438c4b7 2# This file was created by warnings.pl
599cee73
PM
3# Any changes made here will be lost.
4#
5
4438c4b7 6package warnings;
599cee73
PM
7
8=head1 NAME
9
4438c4b7 10warnings - Perl pragma to control optional warnings
599cee73
PM
11
12=head1 SYNOPSIS
13
4438c4b7
JH
14 use warnings;
15 no warnings;
599cee73 16
4438c4b7
JH
17 use warnings "all";
18 no warnings "all";
599cee73 19
d3a7d8c7
GS
20 use warnings::register;
21 if (warnings::enabled()) {
22 warnings::warn("some warning");
23 }
24
25 if (warnings::enabled("void")) {
e476b1b5
GS
26 warnings::warn("void", "some warning");
27 }
28
599cee73
PM
29=head1 DESCRIPTION
30
0453d815
PM
31If no import list is supplied, all possible warnings are either enabled
32or disabled.
599cee73 33
d3a7d8c7 34A number of functions are provided to assist module authors.
e476b1b5
GS
35
36=over 4
37
d3a7d8c7
GS
38=item use warnings::register
39
40Creates a new warnings category which has the same name as the module
41where the call to the pragma is used.
e476b1b5 42
d3a7d8c7 43=item warnings::enabled([$category])
e476b1b5 44
d3a7d8c7
GS
45Returns TRUE if the warnings category C<$category> is enabled in the
46calling module. Otherwise returns FALSE.
e476b1b5 47
d3a7d8c7
GS
48If the parameter, C<$category>, isn't supplied, the current package name
49will be used.
50
51=item warnings::warn([$category,] $message)
599cee73 52
e476b1b5
GS
53If the calling module has I<not> set C<$category> to "FATAL", print
54C<$message> to STDERR.
55If the calling module has set C<$category> to "FATAL", print C<$message>
56STDERR then die.
57
d3a7d8c7
GS
58If the parameter, C<$category>, isn't supplied, the current package name
59will be used.
60
e476b1b5
GS
61=back
62
749f83fa 63See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
599cee73
PM
64
65=cut
66
67use Carp ;
68
d3a7d8c7
GS
69%Offsets = (
70 'all' => 0,
71 'chmod' => 2,
72 'closure' => 4,
73 'exiting' => 6,
74 'glob' => 8,
75 'io' => 10,
76 'closed' => 12,
77 'exec' => 14,
78 'newline' => 16,
79 'pipe' => 18,
80 'unopened' => 20,
81 'misc' => 22,
82 'numeric' => 24,
83 'once' => 26,
84 'overflow' => 28,
85 'pack' => 30,
86 'portable' => 32,
87 'recursion' => 34,
88 'redefine' => 36,
89 'regexp' => 38,
90 'severe' => 40,
91 'debugging' => 42,
92 'inplace' => 44,
93 'internal' => 46,
94 'malloc' => 48,
95 'signal' => 50,
96 'substr' => 52,
97 'syntax' => 54,
98 'ambiguous' => 56,
99 'bareword' => 58,
100 'deprecated' => 60,
101 'digit' => 62,
102 'parenthesis' => 64,
103 'precedence' => 66,
104 'printf' => 68,
105 'prototype' => 70,
106 'qw' => 72,
107 'reserved' => 74,
108 'semicolon' => 76,
109 'taint' => 78,
110 'umask' => 80,
111 'uninitialized' => 82,
112 'unpack' => 84,
113 'untie' => 86,
114 'utf8' => 88,
115 'void' => 90,
116 'y2k' => 92,
117 );
118
599cee73 119%Bits = (
d3a7d8c7
GS
120 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
121 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
122 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
123 'chmod' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
124 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
125 'closure' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
126 'debugging' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
127 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
128 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
129 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
130 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
131 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
132 'inplace' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
133 'internal' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
134 'io' => "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
135 'malloc' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
136 'misc' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
137 'newline' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
138 'numeric' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
139 'once' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
140 'overflow' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
141 'pack' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
142 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
143 'pipe' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
144 'portable' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
145 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
146 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
147 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
148 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
149 'recursion' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
150 'redefine' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
151 'regexp' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
152 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
153 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
154 'severe' => "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24]
155 'signal' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
156 'substr' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
157 'syntax' => "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x15\x00\x00", # [27..38]
158 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
159 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
160 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
161 'unopened' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
162 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
163 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
164 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
165 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
166 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
599cee73
PM
167 );
168
169%DeadBits = (
d3a7d8c7
GS
170 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
171 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
172 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
173 'chmod' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
174 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
175 'closure' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
176 'debugging' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
177 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
178 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
179 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
180 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
181 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
182 'inplace' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
183 'internal' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
184 'io' => "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
185 'malloc' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
186 'misc' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
187 'newline' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
188 'numeric' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
189 'once' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
190 'overflow' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
191 'pack' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
192 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
193 'pipe' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
194 'portable' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
195 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
196 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
197 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
198 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
199 'recursion' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
200 'redefine' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
201 'regexp' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
202 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
203 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
204 'severe' => "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24]
205 'signal' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
206 'substr' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
207 'syntax' => "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x2a\x00\x00", # [27..38]
208 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
209 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
210 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
211 'unopened' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
212 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
213 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
214 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
215 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
216 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
599cee73
PM
217 );
218
d3a7d8c7
GS
219$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
220$LAST_BIT = 94 ;
221$BYTES = 12 ;
222
223$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
599cee73
PM
224
225sub bits {
226 my $mask ;
227 my $catmask ;
228 my $fatal = 0 ;
229 foreach my $word (@_) {
327afb7f
GS
230 if ($word eq 'FATAL') {
231 $fatal = 1;
232 }
d3a7d8c7
GS
233 elsif ($catmask = $Bits{$word}) {
234 $mask |= $catmask ;
235 $mask |= $DeadBits{$word} if $fatal ;
599cee73 236 }
d3a7d8c7
GS
237 else
238 { croak("unknown warnings category '$word'")}
599cee73
PM
239 }
240
241 return $mask ;
242}
243
244sub import {
245 shift;
6a818117 246 ${^WARNING_BITS} |= bits(@_ ? @_ : 'all') ;
599cee73
PM
247}
248
249sub unimport {
250 shift;
d3a7d8c7
GS
251 my $mask = ${^WARNING_BITS} ;
252 if (vec($mask, $Offsets{'all'}, 1)) {
253 $mask = $Bits{'all'} ;
254 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
255 }
256 ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
599cee73
PM
257}
258
259sub enabled
260{
d3a7d8c7
GS
261 croak("Usage: warnings::enabled([category])")
262 unless @_ == 1 || @_ == 0 ;
263 local $Carp::CarpLevel = 1 ;
264 my $category ;
265 my $offset ;
e476b1b5 266 my $callers_bitmask = (caller(1))[9] ;
e476b1b5 267 return 0 unless defined $callers_bitmask ;
d3a7d8c7
GS
268
269
270 if (@_) {
271 # check the category supplied.
272 $category = shift ;
273 $offset = $Offsets{$category};
274 croak("unknown warnings category '$category'")
275 unless defined $offset;
276 }
277 else {
278 $category = (caller(0))[0] ;
279 $offset = $Offsets{$category};
280 croak("package '$category' not registered for warnings")
281 unless defined $offset ;
282 }
283
284 return vec($callers_bitmask, $offset, 1) ||
285 vec($callers_bitmask, $Offsets{'all'}, 1) ;
599cee73
PM
286}
287
d3a7d8c7 288
e476b1b5
GS
289sub warn
290{
d3a7d8c7
GS
291 croak("Usage: warnings::warn([category,] 'message')")
292 unless @_ == 2 || @_ == 1 ;
e476b1b5 293 local $Carp::CarpLevel = 1 ;
d3a7d8c7
GS
294 my $category ;
295 my $offset ;
e476b1b5 296 my $callers_bitmask = (caller(1))[9] ;
d3a7d8c7
GS
297
298 if (@_ == 2) {
299 $category = shift ;
300 $offset = $Offsets{$category};
301 croak("unknown warnings category '$category'")
302 unless defined $offset ;
303 }
304 else {
305 $category = (caller(0))[0] ;
306 $offset = $Offsets{$category};
307 croak("package '$category' not registered for warnings")
308 unless defined $offset ;
309 }
310
311 my $message = shift ;
e476b1b5 312 croak($message)
d3a7d8c7
GS
313 if vec($callers_bitmask, $offset+1, 1) ||
314 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
e476b1b5
GS
315 carp($message) ;
316}
317
599cee73 3181;