1 # -*- buffer-read-only: t -*-
2 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
3 # This file was created by warnings.pl
4 # Any changes made here will be lost.
11 # Verify that we're called correctly so that warnings will work.
13 unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
14 my (undef, $f, $l) = caller;
15 die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
20 warnings - Perl pragma to control optional warnings
30 use warnings::register;
31 if (warnings::enabled()) {
32 warnings::warn("some warning");
35 if (warnings::enabled("void")) {
36 warnings::warn("void", "some warning");
39 if (warnings::enabled($object)) {
40 warnings::warn($object, "some warning");
43 warnings::warnif("some warning");
44 warnings::warnif("void", "some warning");
45 warnings::warnif($object, "some warning");
49 The C<warnings> pragma is a replacement for the command line flag C<-w>,
50 but the pragma is limited to the enclosing block, while the flag is global.
51 See L<perllexwarn> for more information.
53 If no import list is supplied, all possible warnings are either enabled
56 A number of functions are provided to assist module authors.
60 =item use warnings::register
62 Creates a new warnings category with the same name as the package where
63 the call to the pragma is used.
65 =item warnings::enabled()
67 Use the warnings category with the same name as the current package.
69 Return TRUE if that warnings category is enabled in the calling module.
70 Otherwise returns FALSE.
72 =item warnings::enabled($category)
74 Return TRUE if the warnings category, C<$category>, is enabled in the
76 Otherwise returns FALSE.
78 =item warnings::enabled($object)
80 Use the name of the class for the object reference, C<$object>, as the
83 Return TRUE if that warnings category is enabled in the first scope
84 where the object is used.
85 Otherwise returns FALSE.
87 =item warnings::warn($message)
89 Print C<$message> to STDERR.
91 Use the warnings category with the same name as the current package.
93 If that warnings category has been set to "FATAL" in the calling module
94 then die. Otherwise return.
96 =item warnings::warn($category, $message)
98 Print C<$message> to STDERR.
100 If the warnings category, C<$category>, has been set to "FATAL" in the
101 calling module then die. Otherwise return.
103 =item warnings::warn($object, $message)
105 Print C<$message> to STDERR.
107 Use the name of the class for the object reference, C<$object>, as the
110 If that warnings category has been set to "FATAL" in the scope where C<$object>
111 is first used then die. Otherwise return.
114 =item warnings::warnif($message)
118 if (warnings::enabled())
119 { warnings::warn($message) }
121 =item warnings::warnif($category, $message)
125 if (warnings::enabled($category))
126 { warnings::warn($category, $message) }
128 =item warnings::warnif($object, $message)
132 if (warnings::enabled($object))
133 { warnings::warn($object, $message) }
137 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
143 # Warnings Categories added in Perl 5.008
186 'uninitialized' => 82,
192 # Warnings Categories added in Perl 5.011
198 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
199 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
200 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
201 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
202 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
203 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
204 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
205 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
206 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
207 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
208 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
209 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
210 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
211 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
212 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
213 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
214 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
215 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
216 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
217 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
218 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
219 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
220 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
221 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
222 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
223 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
224 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
225 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
226 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
227 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
228 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
229 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
230 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
231 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
232 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
233 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
234 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
235 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
236 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
237 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
238 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
239 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
240 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
241 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
242 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
243 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
244 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
248 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
249 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
250 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
251 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
252 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
253 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
254 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
255 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
256 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
257 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
258 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
259 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
260 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
261 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
262 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
263 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
264 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
265 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
266 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
267 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
268 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
269 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
270 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
271 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
272 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
273 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
274 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
275 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
276 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
277 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
278 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
279 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
280 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
281 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
282 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
283 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
284 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
285 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
286 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
287 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
288 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
289 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
290 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
291 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
292 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
293 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
294 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
297 $NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
301 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
305 require Carp; # this initializes %CarpInternal
306 local $Carp::CarpInternal{'warnings'};
307 delete $Carp::CarpInternal{'warnings'};
313 # called from B::Deparse.pm
315 push @_, 'all' unless @_;
322 foreach my $word ( @_ ) {
323 if ($word eq 'FATAL') {
327 elsif ($word eq 'NONFATAL') {
331 elsif ($catmask = $Bits{$word}) {
333 $mask |= $DeadBits{$word} if $fatal ;
334 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
337 { Croaker("Unknown warnings category '$word'")}
351 my $mask = ${^WARNING_BITS} ;
353 if (vec($mask, $Offsets{'all'}, 1)) {
354 $mask |= $Bits{'all'} ;
355 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
358 push @_, 'all' unless @_;
360 foreach my $word ( @_ ) {
361 if ($word eq 'FATAL') {
365 elsif ($word eq 'NONFATAL') {
369 elsif ($catmask = $Bits{$word}) {
371 $mask |= $DeadBits{$word} if $fatal ;
372 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
375 { Croaker("Unknown warnings category '$word'")}
378 ${^WARNING_BITS} = $mask ;
386 my $mask = ${^WARNING_BITS} ;
388 if (vec($mask, $Offsets{'all'}, 1)) {
389 $mask |= $Bits{'all'} ;
390 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
393 push @_, 'all' unless @_;
395 foreach my $word ( @_ ) {
396 if ($word eq 'FATAL') {
399 elsif ($catmask = $Bits{$word}) {
400 $mask &= ~($catmask | $DeadBits{$word} | $All);
403 { Croaker("Unknown warnings category '$word'")}
406 ${^WARNING_BITS} = $mask ;
409 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
418 # check the category supplied.
420 if (my $type = ref $category) {
421 Croaker("not an object")
422 if exists $builtin_type{$type};
426 $offset = $Offsets{$category};
427 Croaker("Unknown warnings category '$category'")
428 unless defined $offset;
431 $category = (caller(1))[0] ;
432 $offset = $Offsets{$category};
433 Croaker("package '$category' not registered for warnings")
434 unless defined $offset ;
437 my $this_pkg = (caller(1))[0] ;
442 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
443 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
448 $i = _error_loc(); # see where Carp will allocate the error
451 my $callers_bitmask = (caller($i))[9] ;
452 return ($callers_bitmask, $offset, $i) ;
457 goto &Carp::short_error_loc; # don't introduce another stack frame
462 Croaker("Usage: warnings::enabled([category])")
463 unless @_ == 1 || @_ == 0 ;
465 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
467 return 0 unless defined $callers_bitmask ;
468 return vec($callers_bitmask, $offset, 1) ||
469 vec($callers_bitmask, $Offsets{'all'}, 1) ;
475 Croaker("Usage: warnings::warn([category,] 'message')")
476 unless @_ == 2 || @_ == 1 ;
479 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
481 Carp::croak($message)
482 if vec($callers_bitmask, $offset+1, 1) ||
483 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
484 Carp::carp($message) ;
489 Croaker("Usage: warnings::warnif([category,] 'message')")
490 unless @_ == 2 || @_ == 1 ;
493 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
496 unless defined $callers_bitmask &&
497 (vec($callers_bitmask, $offset, 1) ||
498 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
501 Carp::croak($message)
502 if vec($callers_bitmask, $offset+1, 1) ||
503 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
505 Carp::carp($message) ;