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