This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
eliminate "unused var" warning
[perl5.git] / lib / warnings.pm
CommitLineData
37442d52 1# -*- buffer-read-only: t -*-
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
98225a64 9our $VERSION = '1.05';
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
53c33732 134our %Offsets = (
0d658bf5
PM
135
136 # Warnings Categories added in Perl 5.008
137
d3a7d8c7 138 'all' => 0,
3eae5ce4 139 'closure' => 2,
12bcd1a6
PM
140 'deprecated' => 4,
141 'exiting' => 6,
142 'glob' => 8,
143 'io' => 10,
144 'closed' => 12,
145 'exec' => 14,
99ef548b
PM
146 'layer' => 16,
147 'newline' => 18,
148 'pipe' => 20,
149 'unopened' => 22,
150 'misc' => 24,
151 'numeric' => 26,
152 'once' => 28,
153 'overflow' => 30,
154 'pack' => 32,
155 'portable' => 34,
156 'recursion' => 36,
157 'redefine' => 38,
158 'regexp' => 40,
159 'severe' => 42,
160 'debugging' => 44,
161 'inplace' => 46,
162 'internal' => 48,
163 'malloc' => 50,
164 'signal' => 52,
165 'substr' => 54,
166 'syntax' => 56,
167 'ambiguous' => 58,
168 'bareword' => 60,
169 'digit' => 62,
170 'parenthesis' => 64,
171 'precedence' => 66,
172 'printf' => 68,
173 'prototype' => 70,
174 'qw' => 72,
175 'reserved' => 74,
176 'semicolon' => 76,
177 'taint' => 78,
38875929
DM
178 'threads' => 80,
179 'uninitialized' => 82,
180 'unpack' => 84,
181 'untie' => 86,
182 'utf8' => 88,
183 'void' => 90,
8fa7688f
SF
184
185 # Warnings Categories added in Perl 5.009
186
2db3864f 187 'assertions' => 92,
d3a7d8c7
GS
188 );
189
53c33732 190our %Bits = (
2db3864f 191 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
99ef548b 192 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
2db3864f 193 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
99ef548b 194 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
12bcd1a6 195 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4 196 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b 197 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6 198 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b 199 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
12bcd1a6
PM
200 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
201 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
202 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b
PM
203 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
204 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
205 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
206 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
207 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
208 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
209 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
210 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
211 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
212 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
213 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
214 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
215 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
216 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
217 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
218 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
219 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
220 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
221 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
222 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
223 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
224 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
225 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
226 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
227 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
228 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
229 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
230 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
38875929
DM
231 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
232 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
99ef548b 233 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929
DM
234 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
235 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
236 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
237 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
599cee73
PM
238 );
239
53c33732 240our %DeadBits = (
2db3864f 241 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
99ef548b 242 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
2db3864f 243 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
99ef548b 244 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
12bcd1a6 245 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4 246 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b 247 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6 248 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b 249 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
12bcd1a6
PM
250 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
251 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
252 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b
PM
253 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
254 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
255 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
256 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
257 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
258 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
259 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
260 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
261 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
262 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
263 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
264 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
265 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
266 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
267 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
268 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
269 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
270 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
271 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
272 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
273 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
274 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
275 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
276 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
277 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
278 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
279 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
280 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
38875929
DM
281 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
282 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
99ef548b 283 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929
DM
284 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
285 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
286 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
287 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
599cee73
PM
288 );
289
a86a20aa 290$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
2db3864f 291$LAST_BIT = 94 ;
a86a20aa 292$BYTES = 12 ;
d3a7d8c7
GS
293
294$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
599cee73 295
c3186b65
PM
296sub Croaker
297{
29ddba3b 298 require Carp::Heavy; # this initializes %CarpInternal
dbab294c 299 local $Carp::CarpInternal{'warnings'};
c3186b65 300 delete $Carp::CarpInternal{'warnings'};
8becbb3b 301 Carp::croak(@_);
c3186b65
PM
302}
303
6e9af7e4
PM
304sub bits
305{
306 # called from B::Deparse.pm
307
308 push @_, 'all' unless @_;
309
310 my $mask;
599cee73
PM
311 my $catmask ;
312 my $fatal = 0 ;
6e9af7e4
PM
313 my $no_fatal = 0 ;
314
315 foreach my $word ( @_ ) {
316 if ($word eq 'FATAL') {
327afb7f 317 $fatal = 1;
6e9af7e4
PM
318 $no_fatal = 0;
319 }
320 elsif ($word eq 'NONFATAL') {
321 $fatal = 0;
322 $no_fatal = 1;
327afb7f 323 }
d3a7d8c7
GS
324 elsif ($catmask = $Bits{$word}) {
325 $mask |= $catmask ;
326 $mask |= $DeadBits{$word} if $fatal ;
6e9af7e4 327 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
599cee73 328 }
d3a7d8c7 329 else
c3186b65 330 { Croaker("Unknown warnings category '$word'")}
599cee73
PM
331 }
332
333 return $mask ;
334}
335
6e9af7e4
PM
336sub import
337{
599cee73 338 shift;
6e9af7e4
PM
339
340 my $catmask ;
341 my $fatal = 0 ;
342 my $no_fatal = 0 ;
343
f1f33818 344 my $mask = ${^WARNING_BITS} ;
6e9af7e4 345
f1f33818
PM
346 if (vec($mask, $Offsets{'all'}, 1)) {
347 $mask |= $Bits{'all'} ;
348 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
349 }
6e9af7e4
PM
350
351 push @_, 'all' unless @_;
352
353 foreach my $word ( @_ ) {
354 if ($word eq 'FATAL') {
355 $fatal = 1;
356 $no_fatal = 0;
357 }
358 elsif ($word eq 'NONFATAL') {
359 $fatal = 0;
360 $no_fatal = 1;
361 }
362 elsif ($catmask = $Bits{$word}) {
363 $mask |= $catmask ;
364 $mask |= $DeadBits{$word} if $fatal ;
365 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
366 }
367 else
368 { Croaker("Unknown warnings category '$word'")}
369 }
370
371 ${^WARNING_BITS} = $mask ;
599cee73
PM
372}
373
6e9af7e4
PM
374sub unimport
375{
599cee73 376 shift;
6e9af7e4
PM
377
378 my $catmask ;
d3a7d8c7 379 my $mask = ${^WARNING_BITS} ;
6e9af7e4 380
d3a7d8c7 381 if (vec($mask, $Offsets{'all'}, 1)) {
f1f33818 382 $mask |= $Bits{'all'} ;
d3a7d8c7
GS
383 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
384 }
6e9af7e4
PM
385
386 push @_, 'all' unless @_;
387
388 foreach my $word ( @_ ) {
389 if ($word eq 'FATAL') {
390 next;
391 }
392 elsif ($catmask = $Bits{$word}) {
393 $mask &= ~($catmask | $DeadBits{$word} | $All);
394 }
395 else
396 { Croaker("Unknown warnings category '$word'")}
397 }
398
399 ${^WARNING_BITS} = $mask ;
599cee73
PM
400}
401
9df0f64f 402my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
403
7e6d00f8 404sub __chk
599cee73 405{
d3a7d8c7
GS
406 my $category ;
407 my $offset ;
7e6d00f8 408 my $isobj = 0 ;
d3a7d8c7
GS
409
410 if (@_) {
411 # check the category supplied.
412 $category = shift ;
9df0f64f 413 if (my $type = ref $category) {
414 Croaker("not an object")
415 if exists $builtin_type{$type};
416 $category = $type;
7e6d00f8
PM
417 $isobj = 1 ;
418 }
d3a7d8c7 419 $offset = $Offsets{$category};
c3186b65 420 Croaker("Unknown warnings category '$category'")
d3a7d8c7
GS
421 unless defined $offset;
422 }
423 else {
0ca4541c 424 $category = (caller(1))[0] ;
d3a7d8c7 425 $offset = $Offsets{$category};
c3186b65 426 Croaker("package '$category' not registered for warnings")
d3a7d8c7
GS
427 unless defined $offset ;
428 }
429
0ca4541c 430 my $this_pkg = (caller(1))[0] ;
7e6d00f8
PM
431 my $i = 2 ;
432 my $pkg ;
433
434 if ($isobj) {
435 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
436 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
437 }
438 $i -= 2 ;
439 }
440 else {
4f527b71 441 $i = _error_loc(); # see where Carp will allocate the error
7e6d00f8
PM
442 }
443
0ca4541c 444 my $callers_bitmask = (caller($i))[9] ;
7e6d00f8
PM
445 return ($callers_bitmask, $offset, $i) ;
446}
447
4f527b71
AS
448sub _error_loc {
449 require Carp::Heavy;
450 goto &Carp::short_error_loc; # don't introduce another stack frame
451}
452
7e6d00f8
PM
453sub enabled
454{
c3186b65 455 Croaker("Usage: warnings::enabled([category])")
7e6d00f8
PM
456 unless @_ == 1 || @_ == 0 ;
457
458 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
459
460 return 0 unless defined $callers_bitmask ;
d3a7d8c7
GS
461 return vec($callers_bitmask, $offset, 1) ||
462 vec($callers_bitmask, $Offsets{'all'}, 1) ;
599cee73
PM
463}
464
d3a7d8c7 465
e476b1b5
GS
466sub warn
467{
c3186b65 468 Croaker("Usage: warnings::warn([category,] 'message')")
d3a7d8c7 469 unless @_ == 2 || @_ == 1 ;
d3a7d8c7 470
7e6d00f8
PM
471 my $message = pop ;
472 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
09e96b99 473 require Carp;
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
09e96b99 493 require Carp;
8becbb3b 494 Carp::croak($message)
7e6d00f8
PM
495 if vec($callers_bitmask, $offset+1, 1) ||
496 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
497
8becbb3b 498 Carp::carp($message) ;
7e6d00f8 499}
0d658bf5 500
599cee73 5011;
37442d52 502# ex: set ro: