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 warnif("some warning");
36 warnif("void", "some warning");
37 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>.
171 'uninitialized' => 78,
180 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..44]
181 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
182 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
183 'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
184 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
185 'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
186 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
187 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
188 'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
189 'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
190 'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
191 'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
192 'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
193 'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
194 'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
195 'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
196 'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
197 'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
198 'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
199 'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
200 'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
201 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
202 'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
203 'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
204 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
205 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
206 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
207 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
208 'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
209 'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
210 'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
211 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
212 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
213 'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
214 'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
215 'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
216 'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
217 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
218 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
219 'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
220 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
221 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
222 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
223 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
224 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
228 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..44]
229 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
230 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
231 'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
232 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
233 'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
234 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
235 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
236 'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
237 'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
238 'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
239 'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
240 'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
241 'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
242 'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
243 'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
244 'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
245 'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
246 'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
247 'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
248 'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
249 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
250 'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
251 'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
252 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
253 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
254 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
255 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
256 'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
257 'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
258 'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
259 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
260 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
261 'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
262 'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
263 'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
264 'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
265 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
266 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
267 'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
268 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
269 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
270 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
271 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
272 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
275 $NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
279 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
285 foreach my $word (@_) {
286 if ($word eq 'FATAL') {
289 elsif ($catmask = $Bits{$word}) {
291 $mask |= $DeadBits{$word} if $fatal ;
294 { croak("unknown warnings category '$word'")}
302 my $mask = ${^WARNING_BITS} ;
303 if (vec($mask, $Offsets{'all'}, 1)) {
304 $mask |= $Bits{'all'} ;
305 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
307 ${^WARNING_BITS} = $mask | bits(@_ ? @_ : 'all') ;
312 my $mask = ${^WARNING_BITS} ;
313 if (vec($mask, $Offsets{'all'}, 1)) {
314 $mask |= $Bits{'all'} ;
315 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
317 ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
327 # check the category supplied.
330 croak ("not an object")
331 if $category !~ /^([^=]+)=/ ;+
335 $offset = $Offsets{$category};
336 croak("unknown warnings category '$category'")
337 unless defined $offset;
340 $category = (caller(1))[0] ;
341 $offset = $Offsets{$category};
342 croak("package '$category' not registered for warnings")
343 unless defined $offset ;
346 my $this_pkg = (caller(1))[0] ;
351 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
352 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
357 for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
358 last if $pkg ne $this_pkg ;
361 if !$pkg || $pkg eq $this_pkg ;
364 my $callers_bitmask = (caller($i))[9] ;
365 return ($callers_bitmask, $offset, $i) ;
370 croak("Usage: warnings::enabled([category])")
371 unless @_ == 1 || @_ == 0 ;
373 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
375 return 0 unless defined $callers_bitmask ;
376 return vec($callers_bitmask, $offset, 1) ||
377 vec($callers_bitmask, $Offsets{'all'}, 1) ;
383 croak("Usage: warnings::warn([category,] 'message')")
384 unless @_ == 2 || @_ == 1 ;
387 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
388 local $Carp::CarpLevel = $i ;
390 if vec($callers_bitmask, $offset+1, 1) ||
391 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
397 croak("Usage: warnings::warnif([category,] 'message')")
398 unless @_ == 2 || @_ == 1 ;
401 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
402 local $Carp::CarpLevel = $i ;
405 unless defined $callers_bitmask &&
406 (vec($callers_bitmask, $offset, 1) ||
407 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
410 if vec($callers_bitmask, $offset+1, 1) ||
411 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;