This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
enable statically linked extensions for Win32
[perl5.git] / lib / warnings.pm
CommitLineData
599cee73 1
38875929 2# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
4438c4b7 3# This file was created by warnings.pl
599cee73
PM
4# Any changes made here will be lost.
5#
6
4438c4b7 7package warnings;
599cee73 8
8becbb3b 9our $VERSION = '1.03';
0ca4541c 10
599cee73
PM
11=head1 NAME
12
4438c4b7 13warnings - Perl pragma to control optional warnings
599cee73
PM
14
15=head1 SYNOPSIS
16
4438c4b7
JH
17 use warnings;
18 no warnings;
599cee73 19
4438c4b7
JH
20 use warnings "all";
21 no warnings "all";
599cee73 22
d3a7d8c7
GS
23 use warnings::register;
24 if (warnings::enabled()) {
25 warnings::warn("some warning");
26 }
27
28 if (warnings::enabled("void")) {
e476b1b5
GS
29 warnings::warn("void", "some warning");
30 }
31
7e6d00f8
PM
32 if (warnings::enabled($object)) {
33 warnings::warn($object, "some warning");
34 }
35
721f911b
PM
36 warnings::warnif("some warning");
37 warnings::warnif("void", "some warning");
38 warnings::warnif($object, "some warning");
7e6d00f8 39
599cee73
PM
40=head1 DESCRIPTION
41
fe2e802c
EM
42The C<warnings> pragma is a replacement for the command line flag C<-w>,
43but the pragma is limited to the enclosing block, while the flag is global.
44See L<perllexwarn> for more information.
45
0453d815
PM
46If no import list is supplied, all possible warnings are either enabled
47or disabled.
599cee73 48
0ca4541c 49A number of functions are provided to assist module authors.
e476b1b5
GS
50
51=over 4
52
d3a7d8c7
GS
53=item use warnings::register
54
7e6d00f8
PM
55Creates a new warnings category with the same name as the package where
56the call to the pragma is used.
57
58=item warnings::enabled()
59
60Use the warnings category with the same name as the current package.
61
62Return TRUE if that warnings category is enabled in the calling module.
63Otherwise returns FALSE.
64
65=item warnings::enabled($category)
66
67Return TRUE if the warnings category, C<$category>, is enabled in the
68calling module.
69Otherwise returns FALSE.
70
71=item warnings::enabled($object)
72
73Use the name of the class for the object reference, C<$object>, as the
74warnings category.
75
76Return TRUE if that warnings category is enabled in the first scope
77where the object is used.
78Otherwise returns FALSE.
79
80=item warnings::warn($message)
81
82Print C<$message> to STDERR.
83
84Use the warnings category with the same name as the current package.
85
86If that warnings category has been set to "FATAL" in the calling module
87then die. Otherwise return.
88
89=item warnings::warn($category, $message)
90
91Print C<$message> to STDERR.
92
93If the warnings category, C<$category>, has been set to "FATAL" in the
94calling module then die. Otherwise return.
e476b1b5 95
7e6d00f8 96=item warnings::warn($object, $message)
e476b1b5 97
7e6d00f8 98Print C<$message> to STDERR.
e476b1b5 99
7e6d00f8
PM
100Use the name of the class for the object reference, C<$object>, as the
101warnings category.
d3a7d8c7 102
7e6d00f8
PM
103If that warnings category has been set to "FATAL" in the scope where C<$object>
104is first used then die. Otherwise return.
599cee73 105
e476b1b5 106
7e6d00f8
PM
107=item warnings::warnif($message)
108
109Equivalent to:
110
111 if (warnings::enabled())
112 { warnings::warn($message) }
113
114=item warnings::warnif($category, $message)
115
116Equivalent to:
117
118 if (warnings::enabled($category))
119 { warnings::warn($category, $message) }
120
121=item warnings::warnif($object, $message)
122
123Equivalent to:
124
125 if (warnings::enabled($object))
126 { warnings::warn($object, $message) }
d3a7d8c7 127
e476b1b5
GS
128=back
129
749f83fa 130See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
599cee73
PM
131
132=cut
133
8becbb3b 134use Carp ();
599cee73 135
53c33732 136our %Offsets = (
0d658bf5
PM
137
138 # Warnings Categories added in Perl 5.008
139
d3a7d8c7 140 'all' => 0,
3eae5ce4 141 'closure' => 2,
12bcd1a6
PM
142 'deprecated' => 4,
143 'exiting' => 6,
144 'glob' => 8,
145 'io' => 10,
146 'closed' => 12,
147 'exec' => 14,
99ef548b
PM
148 'layer' => 16,
149 'newline' => 18,
150 'pipe' => 20,
151 'unopened' => 22,
152 'misc' => 24,
153 'numeric' => 26,
154 'once' => 28,
155 'overflow' => 30,
156 'pack' => 32,
157 'portable' => 34,
158 'recursion' => 36,
159 'redefine' => 38,
160 'regexp' => 40,
161 'severe' => 42,
162 'debugging' => 44,
163 'inplace' => 46,
164 'internal' => 48,
165 'malloc' => 50,
166 'signal' => 52,
167 'substr' => 54,
168 'syntax' => 56,
169 'ambiguous' => 58,
170 'bareword' => 60,
171 'digit' => 62,
172 'parenthesis' => 64,
173 'precedence' => 66,
174 'printf' => 68,
175 'prototype' => 70,
176 'qw' => 72,
177 'reserved' => 74,
178 'semicolon' => 76,
179 'taint' => 78,
38875929
DM
180 'threads' => 80,
181 'uninitialized' => 82,
182 'unpack' => 84,
183 'untie' => 86,
184 'utf8' => 88,
185 'void' => 90,
186 'y2k' => 92,
8fa7688f
SF
187
188 # Warnings Categories added in Perl 5.009
189
190 'assertions' => 94,
d3a7d8c7
GS
191 );
192
53c33732 193our %Bits = (
8fa7688f 194 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
99ef548b 195 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
8fa7688f 196 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
99ef548b 197 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
12bcd1a6 198 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4 199 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b 200 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6 201 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b 202 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
12bcd1a6
PM
203 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
204 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
205 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b
PM
206 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
207 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
208 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
209 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
210 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
211 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
212 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
213 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
214 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
215 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
216 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
217 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
218 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
219 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
220 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
221 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
222 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
223 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
224 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
225 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
226 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
227 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
228 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
229 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
230 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
231 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
232 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
233 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
38875929
DM
234 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
235 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
99ef548b 236 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929
DM
237 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
238 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
239 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
240 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
241 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
599cee73
PM
242 );
243
53c33732 244our %DeadBits = (
8fa7688f 245 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
99ef548b 246 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
8fa7688f 247 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]
99ef548b 248 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
12bcd1a6 249 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4 250 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b 251 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6 252 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b 253 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
12bcd1a6
PM
254 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
255 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
256 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b
PM
257 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
258 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
259 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
260 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
261 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
262 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
263 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
264 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
265 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
266 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
267 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
268 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
269 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
270 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
271 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
272 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
273 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
274 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
275 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
276 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
277 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
278 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
279 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
280 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
281 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
282 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
283 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
284 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
38875929
DM
285 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
286 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
99ef548b 287 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929
DM
288 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
289 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
290 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
291 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
292 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
599cee73
PM
293 );
294
a86a20aa 295$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
8fa7688f 296$LAST_BIT = 96 ;
a86a20aa 297$BYTES = 12 ;
d3a7d8c7
GS
298
299$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
599cee73 300
c3186b65
PM
301sub Croaker
302{
303 delete $Carp::CarpInternal{'warnings'};
8becbb3b 304 Carp::croak(@_);
c3186b65
PM
305}
306
6e9af7e4
PM
307sub bits
308{
309 # called from B::Deparse.pm
310
311 push @_, 'all' unless @_;
312
313 my $mask;
599cee73
PM
314 my $catmask ;
315 my $fatal = 0 ;
6e9af7e4
PM
316 my $no_fatal = 0 ;
317
318 foreach my $word ( @_ ) {
319 if ($word eq 'FATAL') {
327afb7f 320 $fatal = 1;
6e9af7e4
PM
321 $no_fatal = 0;
322 }
323 elsif ($word eq 'NONFATAL') {
324 $fatal = 0;
325 $no_fatal = 1;
327afb7f 326 }
d3a7d8c7
GS
327 elsif ($catmask = $Bits{$word}) {
328 $mask |= $catmask ;
329 $mask |= $DeadBits{$word} if $fatal ;
6e9af7e4 330 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
599cee73 331 }
d3a7d8c7 332 else
c3186b65 333 { Croaker("Unknown warnings category '$word'")}
599cee73
PM
334 }
335
336 return $mask ;
337}
338
6e9af7e4
PM
339sub import
340{
599cee73 341 shift;
6e9af7e4
PM
342
343 my $catmask ;
344 my $fatal = 0 ;
345 my $no_fatal = 0 ;
346
f1f33818 347 my $mask = ${^WARNING_BITS} ;
6e9af7e4 348
f1f33818
PM
349 if (vec($mask, $Offsets{'all'}, 1)) {
350 $mask |= $Bits{'all'} ;
351 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
352 }
6e9af7e4
PM
353
354 push @_, 'all' unless @_;
355
356 foreach my $word ( @_ ) {
357 if ($word eq 'FATAL') {
358 $fatal = 1;
359 $no_fatal = 0;
360 }
361 elsif ($word eq 'NONFATAL') {
362 $fatal = 0;
363 $no_fatal = 1;
364 }
365 elsif ($catmask = $Bits{$word}) {
366 $mask |= $catmask ;
367 $mask |= $DeadBits{$word} if $fatal ;
368 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
369 }
370 else
371 { Croaker("Unknown warnings category '$word'")}
372 }
373
374 ${^WARNING_BITS} = $mask ;
599cee73
PM
375}
376
6e9af7e4
PM
377sub unimport
378{
599cee73 379 shift;
6e9af7e4
PM
380
381 my $catmask ;
d3a7d8c7 382 my $mask = ${^WARNING_BITS} ;
6e9af7e4 383
d3a7d8c7 384 if (vec($mask, $Offsets{'all'}, 1)) {
f1f33818 385 $mask |= $Bits{'all'} ;
d3a7d8c7
GS
386 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
387 }
6e9af7e4
PM
388
389 push @_, 'all' unless @_;
390
391 foreach my $word ( @_ ) {
392 if ($word eq 'FATAL') {
393 next;
394 }
395 elsif ($catmask = $Bits{$word}) {
396 $mask &= ~($catmask | $DeadBits{$word} | $All);
397 }
398 else
399 { Croaker("Unknown warnings category '$word'")}
400 }
401
402 ${^WARNING_BITS} = $mask ;
599cee73
PM
403}
404
7e6d00f8 405sub __chk
599cee73 406{
d3a7d8c7
GS
407 my $category ;
408 my $offset ;
7e6d00f8 409 my $isobj = 0 ;
d3a7d8c7
GS
410
411 if (@_) {
412 # check the category supplied.
413 $category = shift ;
7e6d00f8 414 if (ref $category) {
c3186b65 415 Croaker ("not an object")
3d1a39c8 416 if $category !~ /^([^=]+)=/ ;
7e6d00f8
PM
417 $category = $1 ;
418 $isobj = 1 ;
419 }
d3a7d8c7 420 $offset = $Offsets{$category};
c3186b65 421 Croaker("Unknown warnings category '$category'")
d3a7d8c7
GS
422 unless defined $offset;
423 }
424 else {
0ca4541c 425 $category = (caller(1))[0] ;
d3a7d8c7 426 $offset = $Offsets{$category};
c3186b65 427 Croaker("package '$category' not registered for warnings")
d3a7d8c7
GS
428 unless defined $offset ;
429 }
430
0ca4541c 431 my $this_pkg = (caller(1))[0] ;
7e6d00f8
PM
432 my $i = 2 ;
433 my $pkg ;
434
435 if ($isobj) {
436 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
437 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
438 }
439 $i -= 2 ;
440 }
441 else {
4f527b71 442 $i = _error_loc(); # see where Carp will allocate the error
7e6d00f8
PM
443 }
444
0ca4541c 445 my $callers_bitmask = (caller($i))[9] ;
7e6d00f8
PM
446 return ($callers_bitmask, $offset, $i) ;
447}
448
4f527b71
AS
449sub _error_loc {
450 require Carp::Heavy;
451 goto &Carp::short_error_loc; # don't introduce another stack frame
452}
453
7e6d00f8
PM
454sub enabled
455{
c3186b65 456 Croaker("Usage: warnings::enabled([category])")
7e6d00f8
PM
457 unless @_ == 1 || @_ == 0 ;
458
459 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
460
461 return 0 unless defined $callers_bitmask ;
d3a7d8c7
GS
462 return vec($callers_bitmask, $offset, 1) ||
463 vec($callers_bitmask, $Offsets{'all'}, 1) ;
599cee73
PM
464}
465
d3a7d8c7 466
e476b1b5
GS
467sub warn
468{
c3186b65 469 Croaker("Usage: warnings::warn([category,] 'message')")
d3a7d8c7 470 unless @_ == 2 || @_ == 1 ;
d3a7d8c7 471
7e6d00f8
PM
472 my $message = pop ;
473 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
8becbb3b 474 Carp::croak($message)
d3a7d8c7
GS
475 if vec($callers_bitmask, $offset+1, 1) ||
476 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
8becbb3b 477 Carp::carp($message) ;
e476b1b5
GS
478}
479
7e6d00f8
PM
480sub warnif
481{
c3186b65 482 Croaker("Usage: warnings::warnif([category,] 'message')")
7e6d00f8
PM
483 unless @_ == 2 || @_ == 1 ;
484
485 my $message = pop ;
486 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
7e6d00f8 487
0ca4541c 488 return
7e6d00f8
PM
489 unless defined $callers_bitmask &&
490 (vec($callers_bitmask, $offset, 1) ||
491 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
492
8becbb3b 493 Carp::croak($message)
7e6d00f8
PM
494 if vec($callers_bitmask, $offset+1, 1) ||
495 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
496
8becbb3b 497 Carp::carp($message) ;
7e6d00f8 498}
0d658bf5 499
599cee73 5001;