2 # This file was created by warnings.pl
3 # Any changes made here will be lost.
12 warnings - Perl pragma to control optional warnings
22 use warnings::register;
23 if (warnings::enabled()) {
24 warnings::warn("some warning");
27 if (warnings::enabled("void")) {
28 warnings::warn("void", "some warning");
31 if (warnings::enabled($object)) {
32 warnings::warn($object, "some warning");
35 warnings::warnif("some warning");
36 warnings::warnif("void", "some warning");
37 warnings::warnif($object, "some warning");
41 If no import list is supplied, all possible warnings are either enabled
44 A number of functions are provided to assist module authors.
48 =item use warnings::register
50 Creates a new warnings category with the same name as the package where
51 the call to the pragma is used.
53 =item warnings::enabled()
55 Use the warnings category with the same name as the current package.
57 Return TRUE if that warnings category is enabled in the calling module.
58 Otherwise returns FALSE.
60 =item warnings::enabled($category)
62 Return TRUE if the warnings category, C<$category>, is enabled in the
64 Otherwise returns FALSE.
66 =item warnings::enabled($object)
68 Use the name of the class for the object reference, C<$object>, as the
71 Return TRUE if that warnings category is enabled in the first scope
72 where the object is used.
73 Otherwise returns FALSE.
75 =item warnings::warn($message)
77 Print C<$message> to STDERR.
79 Use the warnings category with the same name as the current package.
81 If that warnings category has been set to "FATAL" in the calling module
82 then die. Otherwise return.
84 =item warnings::warn($category, $message)
86 Print C<$message> to STDERR.
88 If the warnings category, C<$category>, has been set to "FATAL" in the
89 calling module then die. Otherwise return.
91 =item warnings::warn($object, $message)
93 Print C<$message> to STDERR.
95 Use the name of the class for the object reference, C<$object>, as the
98 If that warnings category has been set to "FATAL" in the scope where C<$object>
99 is first used then die. Otherwise return.
102 =item warnings::warnif($message)
106 if (warnings::enabled())
107 { warnings::warn($message) }
109 =item warnings::warnif($category, $message)
113 if (warnings::enabled($category))
114 { warnings::warn($category, $message) }
116 =item warnings::warnif($object, $message)
120 if (warnings::enabled($object))
121 { warnings::warn($object, $message) }
125 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
172 'uninitialized' => 80,
181 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", # [0..45]
182 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
183 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
184 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
185 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
186 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
187 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
188 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
189 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
190 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
191 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
192 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
193 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
194 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
195 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
196 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
197 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
198 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
199 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
200 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
201 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
202 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
203 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
204 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
205 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
206 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
207 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
208 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
209 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
210 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
211 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
212 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
213 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
214 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
215 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
216 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
217 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
218 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
219 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
220 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
221 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
222 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
223 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
224 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
225 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
226 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
230 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x0a", # [0..45]
231 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
232 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
233 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
234 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
235 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
236 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
237 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
238 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
239 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
240 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
241 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
242 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
243 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
244 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
245 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
246 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
247 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
248 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
249 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
250 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
251 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
252 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
253 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
254 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
255 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
256 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
257 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
258 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
259 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
260 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
261 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
262 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
263 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
264 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
265 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
266 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
267 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
268 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
269 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
270 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
271 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
272 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
273 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
274 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
275 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
278 $NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
282 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
286 delete $Carp::CarpInternal{'warnings'};
294 foreach my $word (@_) {
295 if ($word eq 'FATAL') {
298 elsif ($catmask = $Bits{$word}) {
300 $mask |= $DeadBits{$word} if $fatal ;
303 { Croaker("Unknown warnings category '$word'")}
311 my $mask = ${^WARNING_BITS} ;
312 if (vec($mask, $Offsets{'all'}, 1)) {
313 $mask |= $Bits{'all'} ;
314 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
316 ${^WARNING_BITS} = $mask | bits(@_ ? @_ : 'all') ;
321 my $mask = ${^WARNING_BITS} ;
322 if (vec($mask, $Offsets{'all'}, 1)) {
323 $mask |= $Bits{'all'} ;
324 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
326 ${^WARNING_BITS} = $mask & ~ (bits('FATAL' => (@_ ? @_ : 'all')) | $All) ;
336 # check the category supplied.
339 Croaker ("not an object")
340 if $category !~ /^([^=]+)=/ ;
344 $offset = $Offsets{$category};
345 Croaker("Unknown warnings category '$category'")
346 unless defined $offset;
349 $category = (caller(1))[0] ;
350 $offset = $Offsets{$category};
351 Croaker("package '$category' not registered for warnings")
352 unless defined $offset ;
355 my $this_pkg = (caller(1))[0] ;
360 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
361 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
366 for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
367 last if $pkg ne $this_pkg ;
370 if !$pkg || $pkg eq $this_pkg ;
373 my $callers_bitmask = (caller($i))[9] ;
374 return ($callers_bitmask, $offset, $i) ;
379 Croaker("Usage: warnings::enabled([category])")
380 unless @_ == 1 || @_ == 0 ;
382 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
384 return 0 unless defined $callers_bitmask ;
385 return vec($callers_bitmask, $offset, 1) ||
386 vec($callers_bitmask, $Offsets{'all'}, 1) ;
392 Croaker("Usage: warnings::warn([category,] 'message')")
393 unless @_ == 2 || @_ == 1 ;
396 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
398 if vec($callers_bitmask, $offset+1, 1) ||
399 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
405 Croaker("Usage: warnings::warnif([category,] 'message')")
406 unless @_ == 2 || @_ == 1 ;
409 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
412 unless defined $callers_bitmask &&
413 (vec($callers_bitmask, $offset, 1) ||
414 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
417 if vec($callers_bitmask, $offset+1, 1) ||
418 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;