← Index
NYTProf Performance Profile   « line view »
For t/optimization.t
  Run on Thu Jan 8 22:47:42 2015
Reported on Thu Jan 8 22:48:05 2015

Filename/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/warnings.pm
StatementsExecuted 726 statements in 1.42ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
262611346µs346µswarnings::::unimportwarnings::unimport
411328µs365µswarnings::::register_categorieswarnings::register_categories
434343241µs241µswarnings::::importwarnings::import
82137µs37µswarnings::::_mkMaskwarnings::_mkMask
11116µs16µswarnings::::CORE:regcompwarnings::CORE:regcomp (opcode)
1114µs4µ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
81600nsour $VERSION = '1.13';
9
10# Verify that we're called correctly so that warnings will work.
11# see also strict.pm.
12133µs220µsunless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
# spent 16µs making 1 call to warnings::CORE:regcomp # spent 4µ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
167133µ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
230119µ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
284113µ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
3381300ns$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0";
3391300ns$LAST_BIT = 102 ;
3401100ns$BYTES = 13 ;
341
342210µ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 241µs within warnings::import which was called 43 times, avg 6µs/call: # once (17µs+0s) by overloading::BEGIN@2 at line 2 of overloading.pm # once (9µs+0s) by main::BEGIN@4 at line 4 of t/optimization.t # once (8µs+0s) by Data::DPath::Step::BEGIN@5 at line 5 of lib/Data/DPath/Step.pm # once (8µs+0s) by Test::Deep::BEGIN@2.4 at line 2 of Test/Deep/RegexpVersion.pm # once (7µs+0s) by Test::Deep::BEGIN@2 at line 2 of Test/Deep/Cache.pm # once (7µs+0s) by main::BEGIN@2 at line 2 of Test/Deep.pm # once (7µs+0s) by Test::Deep::HashKeys::BEGIN@2 at line 2 of Test/Deep/HashKeysOnly.pm # once (6µs+0s) by IO::BEGIN@8 at line 8 of IO.pm # once (6µs+0s) by Data::DPath::BEGIN@3 at line 3 of Sub/Exporter.pm # once (6µs+0s) by Test::Deep::BEGIN@2.2 at line 2 of Test/Deep/Stack.pm # once (6µs+0s) by Test::Deep::BEGIN@2.11 at line 2 of Test/Deep/Set.pm # once (6µs+0s) by Test::Deep::BEGIN@2.21 at line 2 of Test/Deep/Blessed.pm # once (6µs+0s) by Sub::Install::BEGIN@3 at line 3 of Sub/Install.pm # once (5µs+0s) by Data::DPath::Path::BEGIN@5 at line 5 of lib/Data/DPath/Path.pm # once (5µs+0s) by POSIX::BEGIN@3 at line 3 of POSIX.pm # once (5µs+0s) by Data::DPath::Filters::BEGIN@5 at line 5 of lib/Data/DPath/Filters.pm # once (5µs+0s) by Test::More::BEGIN@5 at line 5 of Test/More.pm # once (5µs+0s) by Test::Deep::Hash::BEGIN@2.23 at line 2 of Test/Deep/HashElements.pm # once (5µs+0s) by utf8::BEGIN@3 at line 3 of utf8_heavy.pl # once (5µs+0s) by Test::Builder::BEGIN@5 at line 5 of Test/Builder.pm # once (5µs+0s) by Exception::Class::Base::BEGIN@7 at line 7 of Exception/Class/Base.pm # once (5µs+0s) by Class::XSAccessor::BEGIN@4 at line 4 of Class/XSAccessor.pm # once (5µs+0s) by Test::Deep::Stack::BEGIN@2 at line 2 of Test/Deep/MM.pm # once (5µs+0s) by Devel::StackTrace::BEGIN@9 at line 9 of Devel/StackTrace.pm # once (5µs+0s) by Data::DPath::Point::BEGIN@5 at line 5 of lib/Data/DPath/Point.pm # once (5µs+0s) by Class::XSAccessor::Array::BEGIN@4 at line 4 of Class/XSAccessor/Array.pm # once (5µs+0s) by Data::DPath::BEGIN@6 at line 6 of lib/Data/DPath.pm # once (5µs+0s) by Test::Deep::Hash::BEGIN@2.15 at line 2 of Test/Deep/HashKeys.pm # once (5µs+0s) by Data::DPath::Context::BEGIN@5 at line 5 of lib/Data/DPath/Context.pm # once (5µs+0s) by Sub::Exporter::BEGIN@2 at line 2 of Data/OptList.pm # once (5µs+0s) by Test::Deep::BEGIN@2.13 at line 2 of Test/Deep/Hash.pm # once (5µs+0s) by Test::Deep::Set::BEGIN@2 at line 2 of Test/Deep/Cmp.pm # once (5µs+0s) by Devel::StackTrace::Frame::BEGIN@7 at line 7 of Devel/StackTrace/Frame.pm # once (5µs+0s) by Iterator::Util::BEGIN@16 at line 16 of Iterator.pm # once (5µs+0s) by Test::Deep::Cache::BEGIN@2 at line 2 of Test/Deep/Cache/Simple.pm # once (4µs+0s) by Carp::BEGIN@5 at line 5 of Carp.pm # once (4µs+0s) by Test::Deep::BEGIN@2.17 at line 2 of Test/Deep/RefType.pm # once (4µs+0s) by Data::DPath::Attrs::BEGIN@5 at line 5 of lib/Data/DPath/Attrs.pm # once (4µs+0s) by Data::DPath::Context::BEGIN@16 at line 16 of Iterator/Util.pm # once (4µs+0s) by Class::XSAccessor::Heavy::BEGIN@6 at line 6 of Class/XSAccessor/Heavy.pm # once (4µs+0s) by Test::Deep::BEGIN@2.19 at line 2 of Test/Deep/Shallow.pm # once (4µs+0s) by Config::BEGIN@10 at line 10 of Config.pm # once (4µs+0s) by Test::Deep::Hash::BEGIN@2 at line 2 of Test/Deep/Ref.pm
{
3884311µs shift;
389
3904369µs my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
391
3924342µ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' ;
39843295µs ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
399}
400
401sub unimport
402
# spent 346µs within warnings::unimport which was called 26 times, avg 13µs/call: # once (32µs+0s) by Test::Builder::BEGIN@1278 at line 1278 of Test/Builder.pm # once (19µs+0s) by Test::Builder::BEGIN@959 at line 959 of Test/Builder.pm # once (18µs+0s) by Carp::BEGIN@399 at line 399 of Carp.pm # once (18µs+0s) by Test::Builder::BEGIN@1466 at line 1466 of Test/Builder.pm # once (17µs+0s) by Data::DPath::Context::BEGIN@92 at line 92 of lib/Data/DPath/Context.pm # once (16µs+0s) by utf8::BEGIN@147 at line 147 of utf8_heavy.pl # once (14µs+0s) by Data::DPath::Path::BEGIN@115 at line 115 of lib/Data/DPath/Path.pm # once (14µs+0s) by Class::XSAccessor::Heavy::BEGIN@30 at line 30 of Class/XSAccessor/Heavy.pm # once (14µs+0s) by Test::More::BEGIN@1312 at line 1312 of Test/More.pm # once (13µs+0s) by utf8::BEGIN@542 at line 542 of utf8_heavy.pl # once (12µs+0s) by Test::More::BEGIN@1678 at line 1678 of Test/More.pm # once (12µs+0s) by Data::DPath::Filters::BEGIN@26 at line 26 of lib/Data/DPath/Filters.pm # once (12µs+0s) by Class::XSAccessor::Array::BEGIN@62 at line 62 of Class/XSAccessor/Array.pm # once (12µs+0s) by Class::XSAccessor::BEGIN@80 at line 80 of Class/XSAccessor.pm # once (11µs+0s) by Data::DPath::Filters::BEGIN@194 at line 194 of lib/Data/DPath/Context.pm # once (11µs+0s) by Data::DPath::Context::BEGIN@271 at line 271 of lib/Data/DPath/Context.pm # once (11µs+0s) by Test::More::BEGIN@1389 at line 1389 of Test/More.pm # once (10µs+0s) by Carp::BEGIN@406 at line 406 of Carp.pm # once (10µs+0s) by Exporter::Heavy::BEGIN@197 at line 197 of Exporter/Heavy.pm # once (10µs+0s) by Data::DPath::Filters::BEGIN@44 at line 44 of lib/Data/DPath/Filters.pm # once (10µs+0s) by Data::DPath::Context::BEGIN@149 at line 149 of lib/Data/DPath/Context.pm # once (10µs+0s) by Data::DPath::Context::BEGIN@415 at line 415 of lib/Data/DPath/Context.pm # once (10µs+0s) by Data::DPath::Context::BEGIN@295 at line 295 of lib/Data/DPath/Context.pm # once (10µs+0s) by Data::DPath::Context::BEGIN@213 at line 213 of lib/Data/DPath/Context.pm # once (10µs+0s) by Data::DPath::Filters::BEGIN@51 at line 51 of lib/Data/DPath/Filters.pm # once (9µs+0s) by Data::DPath::Filters::BEGIN@58 at line 58 of lib/Data/DPath/Filters.pm
{
403266µs shift;
404
405266µs my $catmask ;
4062666µs my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
407
4082640µs if (vec($mask, $Offsets{'all'}, 1)) {
4092520µs $mask |= $Bits{'all'} ;
4102522µs $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
411 }
412
4132611µs push @_, 'all' unless @_;
414
4152630µs foreach my $word ( @_ ) {
4162686µ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
42626178µs ${^WARNING_BITS} = $mask ;
427}
428
42929µ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 37µs within warnings::_mkMask which was called 8 times, avg 5µs/call: # 4 times (23µs+0s) by warnings::register_categories at line 525, avg 6µs/call # 4 times (14µs+0s) by warnings::register_categories at line 531, avg 4µs/call
{
51285µs my ($bit) = @_;
51383µs my $mask = "";
514
515813µs vec($mask, $bit, 1) = 1;
516839µs return $mask;
517}
518
519sub register_categories
520
# spent 365µs (328+37) within warnings::register_categories which was called 4 times, avg 91µs/call: # 4 times (328µs+37µs) by warnings::register::import at line 43 of warnings/register.pm, avg 91µs/call
{
52144µs my @names = @_;
522
523418µs for my $name (@names) {
52449µs if (! defined $Bits{$name}) {
525410µs423µs $Bits{$name} = _mkMask($LAST_BIT);
# spent 23µs making 4 calls to warnings::_mkMask, avg 6µs/call
52647µs vec($Bits{'all'}, $LAST_BIT, 1) = 1;
52744µs $Offsets{$name} = $LAST_BIT ++;
528448µs foreach my $k (keys %Bits) {
529214196µs vec($Bits{$k}, $LAST_BIT, 1) = 0;
530 }
531410µs414µs $DeadBits{$name} = _mkMask($LAST_BIT);
# spent 14µs making 4 calls to warnings::_mkMask, avg 4µs/call
53247µ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.
56419µsdelete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
565
566138µs1;
567
568# ex: set ro:
 
# spent 4µs within warnings::CORE:match which was called: # once (4µs+0s) by main::BEGIN@4 at line 12
sub warnings::CORE:match; # opcode
# spent 16µs within warnings::CORE:regcomp which was called: # once (16µs+0s) by main::BEGIN@4 at line 12
sub warnings::CORE:regcomp; # opcode