← Index
NYTProf Performance Profile   « block view • line view • sub view »
For lexer.pl
  Run on Thu Mar 22 18:01:49 2012
Reported on Thu Mar 22 18:02:03 2012

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