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