← Index
NYTProf Performance Profile   « line view »
For bin/benchmark-perlformance
  Run on Fri Apr 17 15:31:48 2015
Reported on Fri Apr 17 15:32:02 2015

Filename/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/warnings.pm
StatementsExecuted 781 statements in 1.10ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
611341µs386µswarnings::::register_categorieswarnings::register_categories
20209254µs254µswarnings::::unimportwarnings::unimport
353535143µs143µswarnings::::importwarnings::import
122144µs44µswarnings::::_mkMaskwarnings::_mkMask
11116µs16µswarnings::::CORE:regcompwarnings::CORE:regcomp (opcode)
1116µs6µswarnings::::CORE:matchwarnings::CORE:match (opcode)
0000s0swarnings::::Croakerwarnings::Croaker
0000s0swarnings::::__chkwarnings::__chk
0000s0swarnings::::_bitswarnings::_bits
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 is built by regen/warnings.pl.
4# Any changes made here will be lost!
5
6package warnings;
7
81400nsour $VERSION = '1.13';
9
10# Verify that we're called correctly so that warnings will work.
11# see also strict.pm.
12133µs221µsunless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
# spent 16µs making 1 call to warnings::CORE:regcomp # spent 6µ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 and the list of built-in warning
51categories.
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=item warnings::register_categories(@names)
157
158This registers warning categories for the given names and is primarily for
159use by the warnings::register pragma, for which see L<perllexwarn>.
160
161=back
162
163See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
164
165=cut
166
167131µsour %Offsets = (
168
169 # Warnings Categories added in Perl 5.008
170
171 'all' => 0,
172 'closure' => 2,
173 'deprecated' => 4,
174 'exiting' => 6,
175 'glob' => 8,
176 'io' => 10,
177 'closed' => 12,
178 'exec' => 14,
179 'layer' => 16,
180 'newline' => 18,
181 'pipe' => 20,
182 'unopened' => 22,
183 'misc' => 24,
184 'numeric' => 26,
185 'once' => 28,
186 'overflow' => 30,
187 'pack' => 32,
188 'portable' => 34,
189 'recursion' => 36,
190 'redefine' => 38,
191 'regexp' => 40,
192 'severe' => 42,
193 'debugging' => 44,
194 'inplace' => 46,
195 'internal' => 48,
196 'malloc' => 50,
197 'signal' => 52,
198 'substr' => 54,
199 'syntax' => 56,
200 'ambiguous' => 58,
201 'bareword' => 60,
202 'digit' => 62,
203 'parenthesis' => 64,
204 'precedence' => 66,
205 'printf' => 68,
206 'prototype' => 70,
207 'qw' => 72,
208 'reserved' => 74,
209 'semicolon' => 76,
210 'taint' => 78,
211 'threads' => 80,
212 'uninitialized' => 82,
213 'unpack' => 84,
214 'untie' => 86,
215 'utf8' => 88,
216 'void' => 90,
217
218 # Warnings Categories added in Perl 5.011
219
220 'imprecision' => 92,
221 'illegalproto' => 94,
222
223 # Warnings Categories added in Perl 5.013
224
225 'non_unicode' => 96,
226 'nonchar' => 98,
227 'surrogate' => 100,
228 );
229
230110µsour %Bits = (
231 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..50]
232 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [29]
233 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [30]
234 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
235 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
236 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [22]
237 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
238 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [31]
239 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
240 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
241 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
242 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [47]
243 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [46]
244 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [23]
245 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [24]
246 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
247 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
248 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [25]
249 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
250 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
251 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [48]
252 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [49]
253 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
254 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
255 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
256 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
257 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [32]
258 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
259 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
260 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [33]
261 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [34]
262 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [35]
263 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [36]
264 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
265 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
266 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [20]
267 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [37]
268 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [38]
269 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00", # [21..25]
270 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [26]
271 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [27]
272 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [50]
273 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00", # [28..38,47]
274 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [39]
275 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [40]
276 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [41]
277 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
278 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [42]
279 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [43]
280 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15", # [44,48..50]
281 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [45]
282 );
283
284110µsour %DeadBits = (
285 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..50]
286 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [29]
287 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [30]
288 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
289 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
290 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [22]
291 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
292 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [31]
293 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
294 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
295 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
296 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [47]
297 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [46]
298 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [23]
299 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [24]
300 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
301 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
302 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [25]
303 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
304 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
305 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [48]
306 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [49]
307 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
308 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
309 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
310 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
311 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [32]
312 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
313 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
314 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [33]
315 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [34]
316 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [35]
317 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [36]
318 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
319 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
320 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [20]
321 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [37]
322 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [38]
323 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00", # [21..25]
324 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [26]
325 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [27]
326 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [50]
327 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00", # [28..38,47]
328 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [39]
329 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [40]
330 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [41]
331 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
332 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [42]
333 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [43]
334 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a", # [44,48..50]
335 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [45]
336 );
337
3381200ns$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0";
3391100ns$LAST_BIT = 102 ;
3401100ns$BYTES = 13 ;
341
34226µs$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
343
344sub Croaker
345{
346 require Carp; # this initializes %CarpInternal
347 local $Carp::CarpInternal{'warnings'};
348 delete $Carp::CarpInternal{'warnings'};
349 Carp::croak(@_);
350}
351
352sub _bits {
353 my $mask = shift ;
354 my $catmask ;
355 my $fatal = 0 ;
356 my $no_fatal = 0 ;
357
358 foreach my $word ( @_ ) {
359 if ($word eq 'FATAL') {
360 $fatal = 1;
361 $no_fatal = 0;
362 }
363 elsif ($word eq 'NONFATAL') {
364 $fatal = 0;
365 $no_fatal = 1;
366 }
367 elsif ($catmask = $Bits{$word}) {
368 $mask |= $catmask ;
369 $mask |= $DeadBits{$word} if $fatal ;
370 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
371 }
372 else
373 { Croaker("Unknown warnings category '$word'")}
374 }
375
376 return $mask ;
377}
378
379sub bits
380{
381 # called from B::Deparse.pm
382 push @_, 'all' unless @_ ;
383 return _bits(undef, @_) ;
384}
385
386sub import
387
# spent 143µs within warnings::import which was called 35 times, avg 4µs/call: # once (11µs+0s) by overloading::BEGIN@2 at line 2 of overloading.pm # once (7µs+0s) by Data::YAML::Writer::BEGIN@4 at line 4 of Data/YAML/Writer.pm # once (6µs+0s) by Benchmark::Perl::Formance::BEGIN@5 at line 5 of lib/Benchmark/Perl/Formance.pm # once (6µs+0s) by Data::DPath::BEGIN@3 at line 3 of Sub/Exporter.pm # once (6µs+0s) by File::Basename::BEGIN@52 at line 52 of File/Basename.pm # once (6µs+0s) by Carp::BEGIN@5 at line 5 of Carp.pm # once (5µs+0s) by IO::BEGIN@8 at line 8 of IO.pm # once (5µs+0s) by Config::BEGIN@6 at line 6 of Config_heavy.pl # once (5µs+0s) by Config::Perl::V::BEGIN@6 at line 6 of Config/Perl/V.pm # once (4µs+0s) by Devel::Platform::Info::BEGIN@4 at line 4 of Devel/Platform/Info.pm # once (4µs+0s) by POSIX::BEGIN@3 at line 3 of POSIX.pm # once (4µs+0s) by Sub::Install::BEGIN@3 at line 3 of Sub/Install.pm # once (4µs+0s) by Data::DPath::BEGIN@14 at line 14 of Data/DPath.pm # once (4µs+0s) by utf8::BEGIN@3 at line 3 of utf8_heavy.pl # once (4µs+0s) by Sys::Info::BEGIN@3 at line 3 of Sys/Info.pm # once (4µs+0s) by File::Find::BEGIN@4 at line 4 of File/Find.pm # once (4µs+0s) by aliased::BEGIN@8 at line 8 of aliased.pm # once (3µs+0s) by Data::DPath::Step::BEGIN@11 at line 11 of Data/DPath/Step.pm # once (3µs+0s) by Sys::Info::Base::BEGIN@3 at line 3 of Sys/Info/Base.pm # once (3µs+0s) by Exception::Class::Base::BEGIN@7 at line 7 of Exception/Class/Base.pm # once (3µs+0s) by Sys::Info::Constants::BEGIN@3 at line 3 of Sys/Info/Constants.pm # once (3µs+0s) by Data::DPath::Filters::BEGIN@11 at line 11 of Data/DPath/Filters.pm # once (3µs+0s) by Iterator::Util::BEGIN@16 at line 16 of Iterator.pm # once (3µs+0s) by Config::BEGIN@10 at line 10 of Config.pm # once (3µs+0s) by Data::DPath::Point::BEGIN@11 at line 11 of Data/DPath/Point.pm # once (3µs+0s) by Class::XSAccessor::Array::BEGIN@4 at line 4 of Class/XSAccessor/Array.pm # once (3µs+0s) by Data::DPath::Path::BEGIN@11 at line 11 of Data/DPath/Path.pm # once (3µs+0s) by Devel::StackTrace::BEGIN@9 at line 9 of Devel/StackTrace.pm # once (3µs+0s) by Devel::StackTrace::Frame::BEGIN@7 at line 7 of Devel/StackTrace/Frame.pm # once (3µs+0s) by Sub::Exporter::BEGIN@2 at line 2 of Data/OptList.pm # once (3µs+0s) by Data::DPath::Attrs::BEGIN@11 at line 11 of Data/DPath/Attrs.pm # once (3µs+0s) by Data::DPath::Context::BEGIN@11 at line 11 of Data/DPath/Context.pm # once (3µs+0s) by Class::XSAccessor::BEGIN@4 at line 4 of Class/XSAccessor.pm # once (3µs+0s) by Data::DPath::Context::BEGIN@16.5 at line 16 of Iterator/Util.pm # once (3µs+0s) by Class::XSAccessor::Heavy::BEGIN@6 at line 6 of Class/XSAccessor/Heavy.pm
{
388356µs shift;
389
3903539µs my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
391
3923524µs if (vec($mask, $Offsets{'all'}, 1)) {
393 $mask |= $Bits{'all'} ;
394 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
395 }
396
397 # Empty @_ is equivalent to @_ = 'all' ;
39835179µs ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
399}
400
401sub unimport
402
# spent 254µs within warnings::unimport which was called 20 times, avg 13µs/call: # once (45µs+0s) by Carp::BEGIN@399 at line 399 of Carp.pm # once (23µs+0s) by Data::DPath::Filters::BEGIN@204 at line 204 of Data/DPath/Context.pm # once (18µs+0s) by Data::DPath::Context::BEGIN@102 at line 102 of Data/DPath/Context.pm # once (17µs+0s) by utf8::BEGIN@542 at line 542 of utf8_heavy.pl # once (15µs+0s) by Carp::BEGIN@406 at line 406 of Carp.pm # once (13µs+0s) by Exporter::Heavy::BEGIN@197 at line 197 of Exporter/Heavy.pm # once (13µs+0s) by Data::DPath::Path::BEGIN@121 at line 121 of Data/DPath/Path.pm # once (12µs+0s) by utf8::BEGIN@147 at line 147 of utf8_heavy.pl # once (12µs+0s) by Data::DPath::Context::BEGIN@159 at line 159 of Data/DPath/Context.pm # once (11µs+0s) by Class::XSAccessor::BEGIN@80 at line 80 of Class/XSAccessor.pm # once (11µs+0s) by Class::XSAccessor::Heavy::BEGIN@30 at line 30 of Class/XSAccessor/Heavy.pm # once (8µs+0s) by Data::DPath::Filters::BEGIN@32 at line 32 of Data/DPath/Filters.pm # once (8µs+0s) by Class::XSAccessor::Array::BEGIN@62 at line 62 of Class/XSAccessor/Array.pm # once (8µs+0s) by Data::DPath::Context::BEGIN@281 at line 281 of Data/DPath/Context.pm # once (7µs+0s) by Data::DPath::Context::BEGIN@223 at line 223 of Data/DPath/Context.pm # once (7µs+0s) by Data::DPath::Context::BEGIN@305 at line 305 of Data/DPath/Context.pm # once (7µs+0s) by Data::DPath::Filters::BEGIN@50 at line 50 of Data/DPath/Filters.pm # once (7µs+0s) by Data::DPath::Context::BEGIN@425 at line 425 of Data/DPath/Context.pm # once (7µs+0s) by Data::DPath::Filters::BEGIN@57 at line 57 of Data/DPath/Filters.pm # once (6µs+0s) by Data::DPath::Filters::BEGIN@64 at line 64 of Data/DPath/Filters.pm
{
403204µs shift;
404
405204µs my $catmask ;
4062051µs my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
407
4082023µs if (vec($mask, $Offsets{'all'}, 1)) {
4091912µs $mask |= $Bits{'all'} ;
4101912µs $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
411 }
412
413208µs push @_, 'all' unless @_;
414
4152019µs foreach my $word ( @_ ) {
4162083µs if ($word eq 'FATAL') {
417 next;
418 }
419 elsif ($catmask = $Bits{$word}) {
420 $mask &= ~($catmask | $DeadBits{$word} | $All);
421 }
422 else
423 { Croaker("Unknown warnings category '$word'")}
424 }
425
42620121µs ${^WARNING_BITS} = $mask ;
427}
428
42923µsmy %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
430
431sub MESSAGE () { 4 };
432sub FATAL () { 2 };
433sub NORMAL () { 1 };
434
435sub __chk
436{
437 my $category ;
438 my $offset ;
439 my $isobj = 0 ;
440 my $wanted = shift;
441 my $has_message = $wanted & MESSAGE;
442
443 unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
444 my $sub = (caller 1)[3];
445 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
446 Croaker("Usage: $sub($syntax)");
447 }
448
449 my $message = pop if $has_message;
450
451 if (@_) {
452 # check the category supplied.
453 $category = shift ;
454 if (my $type = ref $category) {
455 Croaker("not an object")
456 if exists $builtin_type{$type};
457 $category = $type;
458 $isobj = 1 ;
459 }
460 $offset = $Offsets{$category};
461 Croaker("Unknown warnings category '$category'")
462 unless defined $offset;
463 }
464 else {
465 $category = (caller(1))[0] ;
466 $offset = $Offsets{$category};
467 Croaker("package '$category' not registered for warnings")
468 unless defined $offset ;
469 }
470
471 my $i;
472
473 if ($isobj) {
474 my $pkg;
475 $i = 2;
476 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
477 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
478 }
479 $i -= 2 ;
480 }
481 else {
482 $i = _error_loc(); # see where Carp will allocate the error
483 }
484
485 # Defaulting this to 0 reduces complexity in code paths below.
486 my $callers_bitmask = (caller($i))[9] || 0 ;
487
488 my @results;
489 foreach my $type (FATAL, NORMAL) {
490 next unless $wanted & $type;
491
492 push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
493 vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
494 }
495
496 # &enabled and &fatal_enabled
497 return $results[0] unless $has_message;
498
499 # &warnif, and the category is neither enabled as warning nor as fatal
500 return if $wanted == (NORMAL | FATAL | MESSAGE)
501 && !($results[0] || $results[1]);
502
503 require Carp;
504 Carp::croak($message) if $results[0];
505 # will always get here for &warn. will only get here for &warnif if the
506 # category is enabled
507 Carp::carp($message);
508}
509
510sub _mkMask
511
# spent 44µs within warnings::_mkMask which was called 12 times, avg 4µs/call: # 6 times (30µs+0s) by warnings::register_categories at line 525, avg 5µs/call # 6 times (15µs+0s) by warnings::register_categories at line 531, avg 2µs/call
{
512127µs my ($bit) = @_;
513124µs my $mask = "";
514
5151215µs vec($mask, $bit, 1) = 1;
5161238µs return $mask;
517}
518
519sub register_categories
520
# spent 386µs (341+44) within warnings::register_categories which was called 6 times, avg 64µs/call: # 6 times (341µs+44µs) by warnings::register::import at line 43 of warnings/register.pm, avg 64µs/call
{
52165µs my @names = @_;
522
523618µs for my $name (@names) {
524610µs if (! defined $Bits{$name}) {
525615µs630µs $Bits{$name} = _mkMask($LAST_BIT);
# spent 30µs making 6 calls to warnings::_mkMask, avg 5µs/call
52669µs vec($Bits{'all'}, $LAST_BIT, 1) = 1;
52766µs $Offsets{$name} = $LAST_BIT ++;
528652µs foreach my $k (keys %Bits) {
529327193µs vec($Bits{$k}, $LAST_BIT, 1) = 0;
530 }
531611µs615µs $DeadBits{$name} = _mkMask($LAST_BIT);
# spent 15µs making 6 calls to warnings::_mkMask, avg 2µs/call
53267µs vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
533 }
534 }
535}
536
537sub _error_loc {
538 require Carp;
539 goto &Carp::short_error_loc; # don't introduce another stack frame
540}
541
542sub enabled
543{
544 return __chk(NORMAL, @_);
545}
546
547sub fatal_enabled
548{
549 return __chk(FATAL, @_);
550}
551
552sub warn
553{
554 return __chk(FATAL | MESSAGE, @_);
555}
556
557sub warnif
558{
559 return __chk(NORMAL | FATAL | MESSAGE, @_);
560}
561
562# These are not part of any public interface, so we can delete them to save
563# space.
56416µsdelete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
565
566125µs1;
567
568# ex: set ro:
 
# spent 6µs within warnings::CORE:match which was called: # once (6µs+0s) by Benchmark::Perl::Formance::BEGIN@5 at line 12
sub warnings::CORE:match; # opcode
# spent 16µs within warnings::CORE:regcomp which was called: # once (16µs+0s) by Benchmark::Perl::Formance::BEGIN@5 at line 12
sub warnings::CORE:regcomp; # opcode