Introduce NVef, NVff, and NVgf, use the middle one.
[perl.git] / lib / warnings.pm
1
2 # This file was created by warnings.pl
3 # Any changes made here will be lost.
4 #
5
6 package warnings;
7
8 =head1 NAME
9
10 warnings - Perl pragma to control optional warnings
11
12 =head1 SYNOPSIS
13
14     use warnings;
15     no warnings;
16
17     use warnings "all";
18     no warnings "all";
19
20     use warnings::register;
21     if (warnings::enabled()) {
22         warnings::warn("some warning");
23     }
24
25     if (warnings::enabled("void")) {
26         warnings::warn("void", "some warning");
27     }
28
29 =head1 DESCRIPTION
30
31 If no import list is supplied, all possible warnings are either enabled
32 or disabled.
33
34 A number of functions are provided to assist module authors. 
35
36 =over 4
37
38 =item use warnings::register
39
40 Creates a new warnings category which has the same name as the module
41 where the call to the pragma is used.
42
43 =item warnings::enabled([$category])
44
45 Returns TRUE if the warnings category C<$category> is enabled in the
46 calling module.  Otherwise returns FALSE.
47
48 If the parameter, C<$category>, isn't supplied, the current package name
49 will be used.
50
51 =item warnings::warn([$category,] $message)
52
53 If the calling module has I<not> set C<$category> to "FATAL", print
54 C<$message> to STDERR.
55 If the calling module has set C<$category> to "FATAL", print C<$message>
56 STDERR then die.
57
58 If the parameter, C<$category>, isn't supplied, the current package name
59 will be used.
60
61 =back
62
63 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
64
65 =cut
66
67 use Carp ;
68
69 %Offsets = (
70     'all'               => 0,
71     'chmod'             => 2,
72     'closure'           => 4,
73     'exiting'           => 6,
74     'glob'              => 8,
75     'io'                => 10,
76     'closed'            => 12,
77     'exec'              => 14,
78     'newline'           => 16,
79     'pipe'              => 18,
80     'unopened'          => 20,
81     'misc'              => 22,
82     'numeric'           => 24,
83     'once'              => 26,
84     'overflow'          => 28,
85     'pack'              => 30,
86     'portable'          => 32,
87     'recursion'         => 34,
88     'redefine'          => 36,
89     'regexp'            => 38,
90     'severe'            => 40,
91     'debugging'         => 42,
92     'inplace'           => 44,
93     'internal'          => 46,
94     'malloc'            => 48,
95     'signal'            => 50,
96     'substr'            => 52,
97     'syntax'            => 54,
98     'ambiguous'         => 56,
99     'bareword'          => 58,
100     'deprecated'        => 60,
101     'digit'             => 62,
102     'parenthesis'       => 64,
103     'precedence'        => 66,
104     'printf'            => 68,
105     'prototype'         => 70,
106     'qw'                => 72,
107     'reserved'          => 74,
108     'semicolon'         => 76,
109     'taint'             => 78,
110     'umask'             => 80,
111     'uninitialized'     => 82,
112     'unpack'            => 84,
113     'untie'             => 86,
114     'utf8'              => 88,
115     'void'              => 90,
116     'y2k'               => 92,
117   );
118
119 %Bits = (
120     'all'               => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
121     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
122     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
123     'chmod'             => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
124     'closed'            => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
125     'closure'           => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
126     'debugging'         => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
127     'deprecated'        => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
128     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
129     'exec'              => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
130     'exiting'           => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
131     'glob'              => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
132     'inplace'           => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
133     'internal'          => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
134     'io'                => "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
135     'malloc'            => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
136     'misc'              => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
137     'newline'           => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
138     'numeric'           => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
139     'once'              => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
140     'overflow'          => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
141     'pack'              => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
142     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
143     'pipe'              => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
144     'portable'          => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
145     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
146     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
147     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
148     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
149     'recursion'         => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
150     'redefine'          => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
151     'regexp'            => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
152     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
153     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
154     'severe'            => "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24]
155     'signal'            => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
156     'substr'            => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
157     'syntax'            => "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x15\x00\x00", # [27..38]
158     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
159     'umask'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
160     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
161     'unopened'          => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
162     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
163     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
164     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
165     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
166     'y2k'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
167   );
168
169 %DeadBits = (
170     'all'               => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
171     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
172     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
173     'chmod'             => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
174     'closed'            => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
175     'closure'           => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
176     'debugging'         => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
177     'deprecated'        => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
178     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
179     'exec'              => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
180     'exiting'           => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
181     'glob'              => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
182     'inplace'           => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
183     'internal'          => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
184     'io'                => "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
185     'malloc'            => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
186     'misc'              => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
187     'newline'           => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
188     'numeric'           => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
189     'once'              => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
190     'overflow'          => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
191     'pack'              => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
192     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
193     'pipe'              => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
194     'portable'          => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
195     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
196     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
197     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
198     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
199     'recursion'         => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
200     'redefine'          => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
201     'regexp'            => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
202     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
203     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
204     'severe'            => "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24]
205     'signal'            => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
206     'substr'            => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
207     'syntax'            => "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x2a\x00\x00", # [27..38]
208     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
209     'umask'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
210     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
211     'unopened'          => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
212     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
213     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
214     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
215     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
216     'y2k'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
217   );
218
219 $NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
220 $LAST_BIT = 94 ;
221 $BYTES    = 12 ;
222
223 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
224
225 sub bits {
226     my $mask ;
227     my $catmask ;
228     my $fatal = 0 ;
229     foreach my $word (@_) {
230         if  ($word eq 'FATAL') {
231             $fatal = 1;
232         }
233         elsif ($catmask = $Bits{$word}) {
234             $mask |= $catmask ;
235             $mask |= $DeadBits{$word} if $fatal ;
236         }
237         else
238           { croak("unknown warnings category '$word'")}  
239     }
240
241     return $mask ;
242 }
243
244 sub import {
245     shift;
246     ${^WARNING_BITS} |= bits(@_ ? @_ : 'all') ;
247 }
248
249 sub unimport {
250     shift;
251     my $mask = ${^WARNING_BITS} ;
252     if (vec($mask, $Offsets{'all'}, 1)) {
253         $mask = $Bits{'all'} ;
254         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
255     }
256     ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
257 }
258
259 sub enabled
260 {
261     croak("Usage: warnings::enabled([category])")
262         unless @_ == 1 || @_ == 0 ;
263     local $Carp::CarpLevel = 1 ;
264     my $category ;
265     my $offset ;
266     my $callers_bitmask = (caller(1))[9] ; 
267     return 0 unless defined $callers_bitmask ;
268
269
270     if (@_) {
271         # check the category supplied.
272         $category = shift ;
273         $offset = $Offsets{$category};
274         croak("unknown warnings category '$category'")
275             unless defined $offset;
276     }
277     else {
278         $category = (caller(0))[0] ; 
279         $offset = $Offsets{$category};
280         croak("package '$category' not registered for warnings")
281             unless defined $offset ;
282     }
283
284     return vec($callers_bitmask, $offset, 1) ||
285            vec($callers_bitmask, $Offsets{'all'}, 1) ;
286 }
287
288
289 sub warn
290 {
291     croak("Usage: warnings::warn([category,] 'message')")
292         unless @_ == 2 || @_ == 1 ;
293     local $Carp::CarpLevel = 1 ;
294     my $category ;
295     my $offset ;
296     my $callers_bitmask = (caller(1))[9] ; 
297
298     if (@_ == 2) {
299         $category = shift ;
300         $offset = $Offsets{$category};
301         croak("unknown warnings category '$category'")
302             unless defined $offset ;
303     }
304     else {
305         $category = (caller(0))[0] ; 
306         $offset = $Offsets{$category};
307         croak("package '$category' not registered for warnings")
308             unless defined $offset ;
309     }
310
311     my $message = shift ;
312     croak($message) 
313         if vec($callers_bitmask, $offset+1, 1) ||
314            vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
315     carp($message) ;
316 }
317
318 1;