This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
c8d61829a945ae2b4bf4a7dc5c24e535832eca95
[perl5.git] / lib / warnings.pm
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.
5 #
6
7 package warnings;
8
9 our $VERSION = '1.11';
10
11 # Verify that we're called correctly so that warnings will work.
12 # see also strict.pm.
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");
16 }
17
18 =head1 NAME
19
20 warnings - Perl pragma to control optional warnings
21
22 =head1 SYNOPSIS
23
24     use warnings;
25     no warnings;
26
27     use warnings "all";
28     no warnings "all";
29
30     use warnings::register;
31     if (warnings::enabled()) {
32         warnings::warn("some warning");
33     }
34
35     if (warnings::enabled("void")) {
36         warnings::warn("void", "some warning");
37     }
38
39     if (warnings::enabled($object)) {
40         warnings::warn($object, "some warning");
41     }
42
43     warnings::warnif("some warning");
44     warnings::warnif("void", "some warning");
45     warnings::warnif($object, "some warning");
46
47 =head1 DESCRIPTION
48
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.
52
53 If no import list is supplied, all possible warnings are either enabled
54 or disabled.
55
56 A number of functions are provided to assist module authors.
57
58 =over 4
59
60 =item use warnings::register
61
62 Creates a new warnings category with the same name as the package where
63 the call to the pragma is used.
64
65 =item warnings::enabled()
66
67 Use the warnings category with the same name as the current package.
68
69 Return TRUE if that warnings category is enabled in the calling module.
70 Otherwise returns FALSE.
71
72 =item warnings::enabled($category)
73
74 Return TRUE if the warnings category, C<$category>, is enabled in the
75 calling module.
76 Otherwise returns FALSE.
77
78 =item warnings::enabled($object)
79
80 Use the name of the class for the object reference, C<$object>, as the
81 warnings category.
82
83 Return TRUE if that warnings category is enabled in the first scope
84 where the object is used.
85 Otherwise returns FALSE.
86
87 =item warnings::fatal_enabled()
88
89 Return TRUE if the warnings category with the same name as the current
90 package has been set to FATAL in the calling module.
91 Otherwise returns FALSE.
92
93 =item warnings::fatal_enabled($category)
94
95 Return TRUE if the warnings category C<$category> has been set to FATAL in
96 the calling module.
97 Otherwise returns FALSE.
98
99 =item warnings::fatal_enabled($object)
100
101 Use the name of the class for the object reference, C<$object>, as the
102 warnings category.
103
104 Return TRUE if that warnings category has been set to FATAL in the first
105 scope where the object is used.
106 Otherwise returns FALSE.
107
108 =item warnings::warn($message)
109
110 Print C<$message> to STDERR.
111
112 Use the warnings category with the same name as the current package.
113
114 If that warnings category has been set to "FATAL" in the calling module
115 then die. Otherwise return.
116
117 =item warnings::warn($category, $message)
118
119 Print C<$message> to STDERR.
120
121 If the warnings category, C<$category>, has been set to "FATAL" in the
122 calling module then die. Otherwise return.
123
124 =item warnings::warn($object, $message)
125
126 Print C<$message> to STDERR.
127
128 Use the name of the class for the object reference, C<$object>, as the
129 warnings category.
130
131 If that warnings category has been set to "FATAL" in the scope where C<$object>
132 is first used then die. Otherwise return.
133
134
135 =item warnings::warnif($message)
136
137 Equivalent to:
138
139     if (warnings::enabled())
140       { warnings::warn($message) }
141
142 =item warnings::warnif($category, $message)
143
144 Equivalent to:
145
146     if (warnings::enabled($category))
147       { warnings::warn($category, $message) }
148
149 =item warnings::warnif($object, $message)
150
151 Equivalent to:
152
153     if (warnings::enabled($object))
154       { warnings::warn($object, $message) }
155
156 =item warnings::register_categories(@names)
157
158 This registers warning categories for the given names and is primarily for
159 use by the warnings::register pragma, for which see L<perllexwarn>.
160
161 =back
162
163 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
164
165 =cut
166
167 our %Offsets = (
168
169     # Warnings Categories added in Perl 5.008
170
171     'all'               => 0,
172     'closure'           => 2,
173     'deprecated'        => 4,
174     'exiting'           => 6,
175     'glob'              => 8,
176     'io'                => 10,
177     'closed'            => 12,
178     'exec'              => 14,
179     'layer'             => 16,
180     'newline'           => 18,
181     'pipe'              => 20,
182     'unopened'          => 22,
183     'misc'              => 24,
184     'numeric'           => 26,
185     'once'              => 28,
186     'overflow'          => 30,
187     'pack'              => 32,
188     'portable'          => 34,
189     'recursion'         => 36,
190     'redefine'          => 38,
191     'regexp'            => 40,
192     'severe'            => 42,
193     'debugging'         => 44,
194     'inplace'           => 46,
195     'internal'          => 48,
196     'malloc'            => 50,
197     'signal'            => 52,
198     'substr'            => 54,
199     'syntax'            => 56,
200     'ambiguous'         => 58,
201     'bareword'          => 60,
202     'digit'             => 62,
203     'parenthesis'       => 64,
204     'precedence'        => 66,
205     'printf'            => 68,
206     'prototype'         => 70,
207     'qw'                => 72,
208     'reserved'          => 74,
209     'semicolon'         => 76,
210     'taint'             => 78,
211     'threads'           => 80,
212     'uninitialized'     => 82,
213     'unpack'            => 84,
214     'untie'             => 86,
215     'utf8'              => 88,
216     'void'              => 90,
217
218     # Warnings Categories added in Perl 5.011
219
220     'imprecision'       => 92,
221     'illegalproto'      => 94,
222   );
223
224 our %Bits = (
225     'all'               => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
226     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
227     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
228     'closed'            => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
229     'closure'           => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
230     'debugging'         => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
231     'deprecated'        => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
232     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
233     'exec'              => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
234     'exiting'           => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
235     'glob'              => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
236     'illegalproto'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
237     'imprecision'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
238     'inplace'           => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
239     'internal'          => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
240     'io'                => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
241     'layer'             => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
242     'malloc'            => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
243     'misc'              => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
244     'newline'           => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
245     'numeric'           => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
246     'once'              => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
247     'overflow'          => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
248     'pack'              => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
249     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
250     'pipe'              => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
251     'portable'          => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
252     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
253     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
254     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
255     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
256     'recursion'         => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
257     'redefine'          => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
258     'regexp'            => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
259     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
260     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
261     'severe'            => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
262     'signal'            => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
263     'substr'            => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
264     'syntax'            => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40", # [28..38,47]
265     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
266     'threads'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
267     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
268     'unopened'          => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
269     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
270     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
271     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
272     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
273   );
274
275 our %DeadBits = (
276     'all'               => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
277     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
278     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
279     'closed'            => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
280     'closure'           => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
281     'debugging'         => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
282     'deprecated'        => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
283     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
284     'exec'              => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
285     'exiting'           => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
286     'glob'              => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
287     'illegalproto'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]
288     'imprecision'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
289     'inplace'           => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
290     'internal'          => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
291     'io'                => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
292     'layer'             => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
293     'malloc'            => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
294     'misc'              => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
295     'newline'           => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
296     'numeric'           => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
297     'once'              => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
298     'overflow'          => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
299     'pack'              => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
300     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
301     'pipe'              => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
302     'portable'          => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
303     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
304     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
305     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
306     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
307     'recursion'         => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
308     'redefine'          => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
309     'regexp'            => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
310     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
311     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
312     'severe'            => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
313     'signal'            => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
314     'substr'            => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
315     'syntax'            => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80", # [28..38,47]
316     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
317     'threads'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
318     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
319     'unopened'          => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
320     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
321     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
322     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
323     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
324   );
325
326 $NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
327 $LAST_BIT = 96 ;
328 $BYTES    = 12 ;
329
330 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
331
332 sub Croaker
333 {
334     require Carp; # this initializes %CarpInternal
335     local $Carp::CarpInternal{'warnings'};
336     delete $Carp::CarpInternal{'warnings'};
337     Carp::croak(@_);
338 }
339
340 sub _bits {
341     my $mask = shift ;
342     my $catmask ;
343     my $fatal = 0 ;
344     my $no_fatal = 0 ;
345
346     foreach my $word ( @_ ) {
347         if ($word eq 'FATAL') {
348             $fatal = 1;
349             $no_fatal = 0;
350         }
351         elsif ($word eq 'NONFATAL') {
352             $fatal = 0;
353             $no_fatal = 1;
354         }
355         elsif ($catmask = $Bits{$word}) {
356             $mask |= $catmask ;
357             $mask |= $DeadBits{$word} if $fatal ;
358             $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
359         }
360         else
361           { Croaker("Unknown warnings category '$word'")}
362     }
363
364     return $mask ;
365 }
366
367 sub bits
368 {
369     # called from B::Deparse.pm
370     push @_, 'all' unless @_ ;
371     return _bits(undef, @_) ;
372 }
373
374 sub import 
375 {
376     shift;
377
378     my $mask = ${^WARNING_BITS} ;
379
380     if (vec($mask, $Offsets{'all'}, 1)) {
381         $mask |= $Bits{'all'} ;
382         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
383     }
384     
385     # Empty @_ is equivalent to @_ = 'all' ;
386     ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
387 }
388
389 sub unimport 
390 {
391     shift;
392
393     my $catmask ;
394     my $mask = ${^WARNING_BITS} ;
395
396     if (vec($mask, $Offsets{'all'}, 1)) {
397         $mask |= $Bits{'all'} ;
398         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
399     }
400
401     push @_, 'all' unless @_;
402
403     foreach my $word ( @_ ) {
404         if ($word eq 'FATAL') {
405             next; 
406         }
407         elsif ($catmask = $Bits{$word}) {
408             $mask &= ~($catmask | $DeadBits{$word} | $All);
409         }
410         else
411           { Croaker("Unknown warnings category '$word'")}
412     }
413
414     ${^WARNING_BITS} = $mask ;
415 }
416
417 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
418
419 sub MESSAGE () { 4 };
420 sub FATAL () { 2 };
421 sub NORMAL () { 1 };
422
423 sub __chk
424 {
425     my $category ;
426     my $offset ;
427     my $isobj = 0 ;
428     my $wanted = shift;
429     my $has_message = $wanted & MESSAGE;
430
431     unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
432         my $sub = (caller 1)[3];
433         my $syntax = $has_message ? "[category,] 'message'" : '[category]';
434         Croaker("Usage: $sub($syntax)");
435     }
436
437     my $message = pop if $has_message;
438
439     if (@_) {
440         # check the category supplied.
441         $category = shift ;
442         if (my $type = ref $category) {
443             Croaker("not an object")
444                 if exists $builtin_type{$type};
445             $category = $type;
446             $isobj = 1 ;
447         }
448         $offset = $Offsets{$category};
449         Croaker("Unknown warnings category '$category'")
450             unless defined $offset;
451     }
452     else {
453         $category = (caller(1))[0] ;
454         $offset = $Offsets{$category};
455         Croaker("package '$category' not registered for warnings")
456             unless defined $offset ;
457     }
458
459     my $i;
460
461     if ($isobj) {
462         my $pkg;
463         $i = 2;
464         while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
465             last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
466         }
467         $i -= 2 ;
468     }
469     else {
470         $i = _error_loc(); # see where Carp will allocate the error
471     }
472
473     # Defaulting this to 0 reduces complexity in code paths below.
474     my $callers_bitmask = (caller($i))[9] || 0 ;
475
476     my @results;
477     foreach my $type (FATAL, NORMAL) {
478         next unless $wanted & $type;
479
480         push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
481                         vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
482     }
483
484     # &enabled and &fatal_enabled
485     return $results[0] unless $has_message;
486
487     # &warnif, and the category is neither enabled as warning nor as fatal
488     return if $wanted == (NORMAL | FATAL | MESSAGE)
489         && !($results[0] || $results[1]);
490
491     require Carp;
492     Carp::croak($message) if $results[0];
493     # will always get here for &warn. will only get here for &warnif if the
494     # category is enabled
495     Carp::carp($message);
496 }
497
498 sub _mkMask
499 {
500     my ($bit) = @_;
501     my $mask = "";
502
503     vec($mask, $bit, 1) = 1;
504     return $mask;
505 }
506
507 sub register_categories
508 {
509     my @names = @_;
510
511     for my $name (@names) {
512         if (! defined $Bits{$name}) {
513             $Bits{$name}     = _mkMask($LAST_BIT);
514             vec($Bits{'all'}, $LAST_BIT, 1) = 1;
515             $Offsets{$name}  = $LAST_BIT ++;
516             foreach my $k (keys %Bits) {
517                 vec($Bits{$k}, $LAST_BIT, 1) = 0;
518             }
519             $DeadBits{$name} = _mkMask($LAST_BIT);
520             vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
521         }
522     }
523 }
524
525 sub _error_loc {
526     require Carp;
527     goto &Carp::short_error_loc; # don't introduce another stack frame
528 }
529
530 sub enabled
531 {
532     return __chk(NORMAL, @_);
533 }
534
535 sub fatal_enabled
536 {
537     return __chk(FATAL, @_);
538 }
539
540 sub warn
541 {
542     return __chk(FATAL | MESSAGE, @_);
543 }
544
545 sub warnif
546 {
547     return __chk(NORMAL | FATAL | MESSAGE, @_);
548 }
549
550 # These are not part of any public interface, so we can delete them to save
551 # space.
552 delete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
553
554 1;
555 # ex: set ro: