← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/dpath
  Run on Tue Jun 5 15:31:33 2012
Reported on Tue Jun 5 15:31:36 2012

Filename/home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/warnings.pm
StatementsExecuted 715 statements in 5.07ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
4111.46ms1.60mswarnings::::register_categorieswarnings::register_categories
2424121.19ms1.19mswarnings::::unimportwarnings::unimport
272727734µs734µswarnings::::importwarnings::import
311251µs1.08mswarnings::::__chkwarnings::__chk
821145µs145µswarnings::::_mkMaskwarnings::_mkMask
11186µs86µswarnings::::CORE:regcompwarnings::CORE:regcomp (opcode)
31151µs1.13mswarnings::::enabledwarnings::enabled
31139µs39µswarnings::::_error_locwarnings::_error_loc
11129µs29µswarnings::::CORE:matchwarnings::CORE:match (opcode)
0000s0swarnings::::Croakerwarnings::Croaker
0000s0swarnings::::_bitswarnings::_bits
0000s0swarnings::::bitswarnings::bits
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 is built by regen/warnings.pl.
4# Any changes made here will be lost!
5
6package warnings;
7
813µsour $VERSION = '1.12';
9
10# Verify that we're called correctly so that warnings will work.
11# see also strict.pm.
121176µs2114µsunless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
# spent 86µs making 1 call to warnings::CORE:regcomp # spent 29µs making 1 call to warnings::CORE:match
13 my (undef, $f, $l) = caller;
14 die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
15}
16
17=head1 NAME
18
19warnings - Perl pragma to control optional warnings
20
21=head1 SYNOPSIS
22
23 use warnings;
24 no warnings;
25
26 use warnings "all";
27 no warnings "all";
28
29 use warnings::register;
30 if (warnings::enabled()) {
31 warnings::warn("some warning");
32 }
33
34 if (warnings::enabled("void")) {
35 warnings::warn("void", "some warning");
36 }
37
38 if (warnings::enabled($object)) {
39 warnings::warn($object, "some warning");
40 }
41
42 warnings::warnif("some warning");
43 warnings::warnif("void", "some warning");
44 warnings::warnif($object, "some warning");
45
46=head1 DESCRIPTION
47
48The C<warnings> pragma is a replacement for the command line flag C<-w>,
49but the pragma is limited to the enclosing block, while the flag is global.
50See L<perllexwarn> for more information.
51
52If no import list is supplied, all possible warnings are either enabled
53or disabled.
54
55A number of functions are provided to assist module authors.
56
57=over 4
58
59=item use warnings::register
60
61Creates a new warnings category with the same name as the package where
62the call to the pragma is used.
63
64=item warnings::enabled()
65
66Use the warnings category with the same name as the current package.
67
68Return TRUE if that warnings category is enabled in the calling module.
69Otherwise returns FALSE.
70
71=item warnings::enabled($category)
72
73Return TRUE if the warnings category, C<$category>, is enabled in the
74calling module.
75Otherwise returns FALSE.
76
77=item warnings::enabled($object)
78
79Use the name of the class for the object reference, C<$object>, as the
80warnings category.
81
82Return TRUE if that warnings category is enabled in the first scope
83where the object is used.
84Otherwise returns FALSE.
85
86=item warnings::fatal_enabled()
87
88Return TRUE if the warnings category with the same name as the current
89package has been set to FATAL in the calling module.
90Otherwise returns FALSE.
91
92=item warnings::fatal_enabled($category)
93
94Return TRUE if the warnings category C<$category> has been set to FATAL in
95the calling module.
96Otherwise returns FALSE.
97
98=item warnings::fatal_enabled($object)
99
100Use the name of the class for the object reference, C<$object>, as the
101warnings category.
102
103Return TRUE if that warnings category has been set to FATAL in the first
104scope where the object is used.
105Otherwise returns FALSE.
106
107=item warnings::warn($message)
108
109Print C<$message> to STDERR.
110
111Use the warnings category with the same name as the current package.
112
113If that warnings category has been set to "FATAL" in the calling module
114then die. Otherwise return.
115
116=item warnings::warn($category, $message)
117
118Print C<$message> to STDERR.
119
120If the warnings category, C<$category>, has been set to "FATAL" in the
121calling module then die. Otherwise return.
122
123=item warnings::warn($object, $message)
124
125Print C<$message> to STDERR.
126
127Use the name of the class for the object reference, C<$object>, as the
128warnings category.
129
130If that warnings category has been set to "FATAL" in the scope where C<$object>
131is first used then die. Otherwise return.
132
133
134=item warnings::warnif($message)
135
136Equivalent to:
137
138 if (warnings::enabled())
139 { warnings::warn($message) }
140
141=item warnings::warnif($category, $message)
142
143Equivalent to:
144
145 if (warnings::enabled($category))
146 { warnings::warn($category, $message) }
147
148=item warnings::warnif($object, $message)
149
150Equivalent to:
151
152 if (warnings::enabled($object))
153 { warnings::warn($object, $message) }
154
155=item warnings::register_categories(@names)
156
157This registers warning categories for the given names and is primarily for
158use by the warnings::register pragma, for which see L<perllexwarn>.
159
160=back
161
162See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
163
164=cut
165
166183µsour %Offsets = (
167
168 # Warnings Categories added in Perl 5.008
169
170 'all' => 0,
171 'closure' => 2,
172 'deprecated' => 4,
173 'exiting' => 6,
174 'glob' => 8,
175 'io' => 10,
176 'closed' => 12,
177 'exec' => 14,
178 'layer' => 16,
179 'newline' => 18,
180 'pipe' => 20,
181 'unopened' => 22,
182 'misc' => 24,
183 'numeric' => 26,
184 'once' => 28,
185 'overflow' => 30,
186 'pack' => 32,
187 'portable' => 34,
188 'recursion' => 36,
189 'redefine' => 38,
190 'regexp' => 40,
191 'severe' => 42,
192 'debugging' => 44,
193 'inplace' => 46,
194 'internal' => 48,
195 'malloc' => 50,
196 'signal' => 52,
197 'substr' => 54,
198 'syntax' => 56,
199 'ambiguous' => 58,
200 'bareword' => 60,
201 'digit' => 62,
202 'parenthesis' => 64,
203 'precedence' => 66,
204 'printf' => 68,
205 'prototype' => 70,
206 'qw' => 72,
207 'reserved' => 74,
208 'semicolon' => 76,
209 'taint' => 78,
210 'threads' => 80,
211 'uninitialized' => 82,
212 'unpack' => 84,
213 'untie' => 86,
214 'utf8' => 88,
215 'void' => 90,
216
217 # Warnings Categories added in Perl 5.011
218
219 'imprecision' => 92,
220 'illegalproto' => 94,
221
222 # Warnings Categories added in Perl 5.013
223
224 'non_unicode' => 96,
225 'nonchar' => 98,
226 'surrogate' => 100,
227 );
228
229152µsour %Bits = (
230 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..50]
231 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [29]
232 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [30]
233 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
234 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
235 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [22]
236 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
237 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [31]
238 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
239 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
240 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
241 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [47]
242 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [46]
243 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [23]
244 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [24]
245 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
246 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
247 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [25]
248 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
249 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
250 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [48]
251 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [49]
252 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
253 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
254 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
255 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
256 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [32]
257 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
258 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
259 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [33]
260 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [34]
261 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [35]
262 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [36]
263 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
264 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
265 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [20]
266 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [37]
267 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [38]
268 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00", # [21..25]
269 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [26]
270 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [27]
271 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [50]
272 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00", # [28..38,47]
273 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [39]
274 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [40]
275 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [41]
276 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
277 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [42]
278 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [43]
279 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15", # [44,48..50]
280 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [45]
281 );
282
283165µsour %DeadBits = (
284 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..50]
285 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [29]
286 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [30]
287 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
288 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
289 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [22]
290 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
291 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [31]
292 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
293 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
294 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
295 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [47]
296 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [46]
297 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [23]
298 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [24]
299 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
300 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
301 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [25]
302 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
303 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
304 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [48]
305 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [49]
306 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
307 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
308 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
309 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
310 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [32]
311 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
312 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
313 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [33]
314 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [34]
315 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [35]
316 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [36]
317 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
318 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
319 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [20]
320 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [37]
321 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [38]
322 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00", # [21..25]
323 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [26]
324 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [27]
325 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [50]
326 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00", # [28..38,47]
327 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [39]
328 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [40]
329 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [41]
330 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
331 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [42]
332 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [43]
333 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a", # [44,48..50]
334 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [45]
335 );
336
33712µs$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0";
33811µs$LAST_BIT = 102 ;
3391500ns$BYTES = 13 ;
340
341235µs$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
342
343sub Croaker
344{
345 require Carp; # this initializes %CarpInternal
346 local $Carp::CarpInternal{'warnings'};
347 delete $Carp::CarpInternal{'warnings'};
348 Carp::croak(@_);
349}
350
351sub _bits {
352 my $mask = shift ;
353 my $catmask ;
354 my $fatal = 0 ;
355 my $no_fatal = 0 ;
356
357 foreach my $word ( @_ ) {
358 if ($word eq 'FATAL') {
359 $fatal = 1;
360 $no_fatal = 0;
361 }
362 elsif ($word eq 'NONFATAL') {
363 $fatal = 0;
364 $no_fatal = 1;
365 }
366 elsif ($catmask = $Bits{$word}) {
367 $mask |= $catmask ;
368 $mask |= $DeadBits{$word} if $fatal ;
369 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
370 }
371 else
372 { Croaker("Unknown warnings category '$word'")}
373 }
374
375 return $mask ;
376}
377
378sub bits
379{
380 # called from B::Deparse.pm
381 push @_, 'all' unless @_ ;
382 return _bits(undef, @_) ;
383}
384
385sub import
386
# spent 734µs within warnings::import which was called 27 times, avg 27µs/call: # once (43µs+0s) by main::BEGIN@7 at line 7 of bin/dpath # once (42µs+0s) by POSIX::BEGIN@3 at line 3 of POSIX.pm # once (37µs+0s) by Sub::Install::BEGIN@3 at line 3 of Sub/Install.pm # once (30µs+0s) by utf8::BEGIN@3 at line 3 of utf8_heavy.pl # once (30µs+0s) by Data::DPath::BEGIN@3 at line 3 of Sub/Exporter.pm # once (30µs+0s) by App::Rad::BEGIN@5 at line 5 of App/Rad.pm # once (29µs+0s) by Data::DPath::Filters::BEGIN@11 at line 11 of Data/DPath/Filters.pm # once (29µs+0s) by Iterator::Util::BEGIN@16 at line 16 of Iterator.pm # once (29µs+0s) by Config::BEGIN@10 at line 10 of Config.pm # once (29µs+0s) by Data::DPath::Context::BEGIN@11 at line 11 of Data/DPath/Context.pm # once (28µs+0s) by IO::BEGIN@8 at line 8 of IO.pm # once (28µs+0s) by Data::DPath::BEGIN@12 at line 12 of Data/DPath.pm # once (28µs+0s) by Data::DPath::Step::BEGIN@11 at line 11 of Data/DPath/Step.pm # once (28µs+0s) by Devel::StackTrace::BEGIN@9 at line 9 of Devel/StackTrace.pm # once (27µs+0s) by Attribute::Handlers::BEGIN@4 at line 4 of Attribute/Handlers.pm # once (27µs+0s) by Data::DPath::Point::BEGIN@11 at line 11 of Data/DPath/Point.pm # once (25µs+0s) by Data::DPath::Context::BEGIN@16.5 at line 16 of Iterator/Util.pm # once (25µs+0s) by Carp::BEGIN@5 at line 5 of Carp.pm # once (24µs+0s) by Exception::Class::Base::BEGIN@7 at line 7 of Exception/Class/Base.pm # once (24µs+0s) by Data::DPath::Attrs::BEGIN@11 at line 11 of Data/DPath/Attrs.pm # once (22µs+0s) by Class::XSAccessor::BEGIN@4 at line 4 of Class/XSAccessor.pm # once (22µs+0s) by App::Rad::Help::BEGIN@4 at line 4 of App/Rad/Help.pm # once (20µs+0s) by Class::XSAccessor::Heavy::BEGIN@6 at line 6 of Class/XSAccessor/Heavy.pm # once (20µs+0s) by Class::XSAccessor::Array::BEGIN@4 at line 4 of Class/XSAccessor/Array.pm # once (20µs+0s) by Data::DPath::Path::BEGIN@11 at line 11 of Data/DPath/Path.pm # once (19µs+0s) by Devel::StackTrace::Frame::BEGIN@7 at line 7 of Devel/StackTrace/Frame.pm # once (19µs+0s) by Sub::Exporter::BEGIN@2 at line 2 of Data/OptList.pm
{
387108999µs shift;
388
389 my $mask = ${^WARNING_BITS} ;
390
391 if (vec($mask, $Offsets{'all'}, 1)) {
392 $mask |= $Bits{'all'} ;
393 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
394 }
395
396 # Empty @_ is equivalent to @_ = 'all' ;
397 ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
398}
399
400sub unimport
401
# spent 1.19ms within warnings::unimport which was called 24 times, avg 50µs/call: # once (66µs+0s) by Attribute::Handlers::BEGIN@215 at line 215 of Attribute/Handlers.pm # once (66µs+0s) by Carp::BEGIN@399 at line 399 of Carp.pm # once (64µs+0s) by Data::DPath::Path::BEGIN@121 at line 121 of Data/DPath/Path.pm # once (64µs+0s) by POSIX::BEGIN@39 at line 39 of POSIX.pm # once (62µs+0s) by Class::XSAccessor::Array::BEGIN@62 at line 62 of Class/XSAccessor/Array.pm # once (60µs+0s) by Data::DPath::Context::BEGIN@102 at line 102 of Data/DPath/Context.pm # once (59µs+0s) by utf8::BEGIN@460 at line 460 of utf8_heavy.pl # once (58µs+0s) by utf8::BEGIN@117 at line 117 of utf8_heavy.pl # once (58µs+0s) by Data::DPath::Filters::BEGIN@32 at line 32 of Data/DPath/Filters.pm # once (55µs+0s) by Exporter::Heavy::BEGIN@197 at line 197 of Exporter/Heavy.pm # once (52µs+0s) by Class::XSAccessor::BEGIN@80 at line 80 of Class/XSAccessor.pm # once (52µs+0s) by main::BEGIN@1 at line 1 of (eval 47)[Attribute/Handlers.pm:218] # once (50µs+0s) by Class::XSAccessor::Heavy::BEGIN@30 at line 30 of Class/XSAccessor/Heavy.pm # once (50µs+0s) by Data::DPath::Context::BEGIN@425 at line 425 of Data/DPath/Context.pm # once (45µs+0s) by Data::DPath::Filters::BEGIN@204 at line 204 of Data/DPath/Context.pm # once (45µs+0s) by Data::DPath::Context::BEGIN@281 at line 281 of Data/DPath/Context.pm # once (42µs+0s) by Data::DPath::Context::BEGIN@159 at line 159 of Data/DPath/Context.pm # once (38µs+0s) by Data::DPath::Filters::BEGIN@50 at line 50 of Data/DPath/Filters.pm # once (36µs+0s) by Attribute::Handlers::BEGIN@236 at line 236 of Attribute/Handlers.pm # once (35µs+0s) by Carp::BEGIN@406 at line 406 of Carp.pm # once (34µs+0s) by Data::DPath::Context::BEGIN@223 at line 223 of Data/DPath/Context.pm # once (34µs+0s) by Data::DPath::Context::BEGIN@305 at line 305 of Data/DPath/Context.pm # once (34µs+0s) by Data::DPath::Filters::BEGIN@64 at line 64 of Data/DPath/Filters.pm # once (34µs+0s) by Data::DPath::Filters::BEGIN@57 at line 57 of Data/DPath/Filters.pm
{
4022361.50ms shift;
403
404 my $catmask ;
405 my $mask = ${^WARNING_BITS} ;
406
407 if (vec($mask, $Offsets{'all'}, 1)) {
408 $mask |= $Bits{'all'} ;
409 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
410 }
411
412 push @_, 'all' unless @_;
413
414 foreach my $word ( @_ ) {
415 if ($word eq 'FATAL') {
416 next;
417 }
418 elsif ($catmask = $Bits{$word}) {
419 $mask &= ~($catmask | $DeadBits{$word} | $All);
420 }
421 else
422 { Croaker("Unknown warnings category '$word'")}
423 }
424
425 ${^WARNING_BITS} = $mask ;
426}
427
428212µsmy %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
429
430sub MESSAGE () { 4 };
431sub FATAL () { 2 };
432sub NORMAL () { 1 };
433
434sub __chk
435
# spent 1.08ms (251µs+830µs) within warnings::__chk which was called 3 times, avg 360µs/call: # 3 times (251µs+830µs) by warnings::enabled at line 543, avg 360µs/call
{
43666216µs my $category ;
437 my $offset ;
438 my $isobj = 0 ;
439 my $wanted = shift;
440 my $has_message = $wanted & MESSAGE;
441
442 unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
443 my $sub = (caller 1)[3];
444 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
445 Croaker("Usage: $sub($syntax)");
446 }
447
448 my $message = pop if $has_message;
449
450 if (@_) {
451 # check the category supplied.
452 $category = shift ;
453 if (my $type = ref $category) {
454 Croaker("not an object")
455 if exists $builtin_type{$type};
456 $category = $type;
457 $isobj = 1 ;
458 }
459 $offset = $Offsets{$category};
460 Croaker("Unknown warnings category '$category'")
461 unless defined $offset;
462 }
463 else {
464 $category = (caller(1))[0] ;
465 $offset = $Offsets{$category};
466 Croaker("package '$category' not registered for warnings")
467 unless defined $offset ;
468 }
469
470 my $i;
471
472 if ($isobj) {
473 my $pkg;
474 $i = 2;
475 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
476 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
477 }
478 $i -= 2 ;
479 }
480 else {
481339µs $i = _error_loc(); # see where Carp will allocate the error
# spent 39µs making 3 calls to warnings::_error_loc, avg 13µs/call
482 }
483
484 # Defaulting this to 0 reduces complexity in code paths below.
485 my $callers_bitmask = (caller($i))[9] || 0 ;
486
487 my @results;
488 foreach my $type (FATAL, NORMAL) {
489 next unless $wanted & $type;
490
491 push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
492 vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
493 }
494
495 # &enabled and &fatal_enabled
496 return $results[0] unless $has_message;
497
498 # &warnif, and the category is neither enabled as warning nor as fatal
499 return if $wanted == (NORMAL | FATAL | MESSAGE)
500 && !($results[0] || $results[1]);
501
502 require Carp;
503 Carp::croak($message) if $results[0];
504 # will always get here for &warn. will only get here for &warnif if the
505 # category is enabled
506 Carp::carp($message);
507}
508
509sub _mkMask
510
# spent 145µs within warnings::_mkMask which was called 8 times, avg 18µs/call: # 4 times (92µs+0s) by warnings::register_categories at line 524, avg 23µs/call # 4 times (53µs+0s) by warnings::register_categories at line 530, avg 13µs/call
{
51132204µs my ($bit) = @_;
512 my $mask = "";
513
514 vec($mask, $bit, 1) = 1;
515 return $mask;
516}
517
518sub register_categories
519
# spent 1.60ms (1.46+145µs) within warnings::register_categories which was called 4 times, avg 401µs/call: # 4 times (1.46ms+145µs) by warnings::register::import at line 43 of warnings/register.pm, avg 401µs/call
{
5202501.41ms my @names = @_;
521
522 for my $name (@names) {
523 if (! defined $Bits{$name}) {
524492µs $Bits{$name} = _mkMask($LAST_BIT);
# spent 92µs making 4 calls to warnings::_mkMask, avg 23µs/call
525 vec($Bits{'all'}, $LAST_BIT, 1) = 1;
526 $Offsets{$name} = $LAST_BIT ++;
527 foreach my $k (keys %Bits) {
528 vec($Bits{$k}, $LAST_BIT, 1) = 0;
529 }
530453µs $DeadBits{$name} = _mkMask($LAST_BIT);
# spent 53µs making 4 calls to warnings::_mkMask, avg 13µs/call
531 vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
532 }
533 }
534}
535
536
# spent 39µs within warnings::_error_loc which was called 3 times, avg 13µs/call: # 3 times (39µs+0s) by warnings::__chk at line 481, avg 13µs/call
sub _error_loc {
537679µs require Carp;
5383791µs goto &Carp::short_error_loc; # don't introduce another stack frame
# spent 791µs making 3 calls to Carp::short_error_loc, avg 264µs/call
539}
540
541sub enabled
542
# spent 1.13ms (51µs+1.08) within warnings::enabled which was called 3 times, avg 378µs/call: # 3 times (51µs+1.08ms) by attributes::import at line 58 of attributes.pm, avg 378µs/call
{
543341µs31.08ms return __chk(NORMAL, @_);
# spent 1.08ms making 3 calls to warnings::__chk, avg 360µs/call
544}
545
546sub fatal_enabled
547{
548 return __chk(FATAL, @_);
549}
550
551sub warn
552{
553 return __chk(FATAL | MESSAGE, @_);
554}
555
556sub warnif
557{
558 return __chk(NORMAL | FATAL | MESSAGE, @_);
559}
560
561# These are not part of any public interface, so we can delete them to save
562# space.
563133µsdelete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
564
5651154µs1;
566
567# ex: set ro:
 
# spent 29µs within warnings::CORE:match which was called: # once (29µs+0s) by main::BEGIN@7 at line 12
sub warnings::CORE:match; # opcode
# spent 86µs within warnings::CORE:regcomp which was called: # once (86µs+0s) by main::BEGIN@7 at line 12
sub warnings::CORE:regcomp; # opcode