← Index
NYTProf Performance Profile   « line view »
For runner.pl
  Run on Thu Jul 3 15:14:19 2014
Reported on Thu Jul 3 15:16:35 2014

Filename/usr/share/perl5/core_perl/warnings.pm
StatementsExecuted 287 statements in 1.46ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
311602µs670µswarnings::::register_categorieswarnings::register_categories
777115µs115µswarnings::::importwarnings::import
11176µs76µswarnings::::CORE:regcompwarnings::CORE:regcomp (opcode)
22172µs72µswarnings::::unimportwarnings::unimport
62167µs67µswarnings::::_mkMaskwarnings::_mkMask
11124µs24µ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
812µsour $VERSION = '1.18';
9
10# Verify that we're called correctly so that warnings will work.
11# see also strict.pm.
121169µs2100µsunless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
# spent 76µs making 1 call to warnings::CORE:regcomp # spent 24µ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
167150µ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 # Warnings Categories added in Perl 5.017
230
231 'experimental' => 102,
232 'experimental::lexical_subs'=> 104,
233 'experimental::lexical_topic'=> 106,
234 'experimental::regex_sets'=> 108,
235 'experimental::smartmatch'=> 110,
236 );
237
238158µsour %Bits = (
239 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..55]
240 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [29]
241 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [30]
242 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
243 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
244 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
245 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
246 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [31]
247 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
248 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
249 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55", # [51..55]
250 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [52]
251 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [53]
252 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [54]
253 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [55]
254 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
255 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [47]
256 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [46]
257 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
258 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [24]
259 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
260 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
261 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [25]
262 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
263 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
264 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [48]
265 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [49]
266 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
267 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
268 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
269 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
270 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [32]
271 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
272 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
273 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [33]
274 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [34]
275 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [35]
276 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [36]
277 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
278 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
279 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
280 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [37]
281 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [38]
282 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00", # [21..25]
283 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [26]
284 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [27]
285 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [50]
286 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00", # [28..38,47]
287 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [39]
288 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [40]
289 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [41]
290 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
291 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [42]
292 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [43]
293 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00", # [44,48..50]
294 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [45]
295 );
296
297148µsour %DeadBits = (
298 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..55]
299 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [29]
300 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [30]
301 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
302 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
303 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
304 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
305 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [31]
306 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
307 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
308 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa", # [51..55]
309 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [52]
310 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [53]
311 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [54]
312 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [55]
313 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
314 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [47]
315 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [46]
316 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
317 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [24]
318 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
319 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
320 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [25]
321 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
322 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
323 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [48]
324 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [49]
325 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
326 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
327 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
328 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
329 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [32]
330 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
331 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
332 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [33]
333 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [34]
334 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [35]
335 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [36]
336 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
337 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
338 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
339 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [37]
340 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [38]
341 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00", # [21..25]
342 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [26]
343 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [27]
344 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [50]
345 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00", # [28..38,47]
346 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [39]
347 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [40]
348 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [41]
349 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
350 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [42]
351 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [43]
352 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00", # [44,48..50]
353 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [45]
354 );
355
3561800ns$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
35715µs$DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55", # [2,52..55,4,22,23,25]
358$LAST_BIT = 112 ;
3591500ns$BYTES = 14 ;
360
361225µs$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
362
363sub Croaker
364{
365 require Carp; # this initializes %CarpInternal
366 local $Carp::CarpInternal{'warnings'};
367 delete $Carp::CarpInternal{'warnings'};
368 Carp::croak(@_);
369}
370
371sub _bits {
372 my $mask = shift ;
373 my $catmask ;
374 my $fatal = 0 ;
375 my $no_fatal = 0 ;
376
377 foreach my $word ( @_ ) {
378 if ($word eq 'FATAL') {
379 $fatal = 1;
380 $no_fatal = 0;
381 }
382 elsif ($word eq 'NONFATAL') {
383 $fatal = 0;
384 $no_fatal = 1;
385 }
386 elsif ($catmask = $Bits{$word}) {
387 $mask |= $catmask ;
388 $mask |= $DeadBits{$word} if $fatal ;
389 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
390 }
391 else
392 { Croaker("Unknown warnings category '$word'")}
393 }
394
395 return $mask ;
396}
397
398sub bits
399{
400 # called from B::Deparse.pm
401 push @_, 'all' unless @_ ;
402 return _bits(undef, @_) ;
403}
404
405sub import
406
# spent 115µs within warnings::import which was called 7 times, avg 16µs/call: # once (28µs+0s) by Runner::BEGIN@8 at line 8 of runner.pl # once (18µs+0s) by overloading::BEGIN@2 at line 2 of overloading.pm # once (17µs+0s) by Runner::IO::BEGIN@4 at line 4 of Runner/IO.pm # once (16µs+0s) by Runner::Job::BEGIN@4 at line 4 of Runner/Job.pm # once (15µs+0s) by Carp::BEGIN@5 at line 5 of Carp.pm # once (11µs+0s) by Runner::Stats::BEGIN@4 at line 4 of Runner/Stats.pm # once (11µs+0s) by Config::BEGIN@10 at line 10 of Config.pm
{
40774µs shift;
408
409729µs my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
410
411720µs if (vec($mask, $Offsets{'all'}, 1)) {
412 $mask |= $Bits{'all'} ;
413 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
414 }
415
416 # Empty @_ is equivalent to @_ = 'all' ;
4177131µs ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
418}
419
420sub unimport
421
# spent 72µs within warnings::unimport which was called 2 times, avg 36µs/call: # once (42µs+0s) by Carp::BEGIN@434 at line 434 of Carp.pm # once (30µs+0s) by Carp::BEGIN@441 at line 441 of Carp.pm
{
42221µs shift;
423
42421µs my $catmask ;
425213µs my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
426
42727µs if (vec($mask, $Offsets{'all'}, 1)) {
42824µs $mask |= $Bits{'all'} ;
42924µs $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
430 }
431
43221µs push @_, 'all' unless @_;
433
43426µs foreach my $word ( @_ ) {
435220µs if ($word eq 'FATAL') {
436 next;
437 }
438 elsif ($catmask = $Bits{$word}) {
439 $mask &= ~($catmask | $DeadBits{$word} | $All);
440 }
441 else
442 { Croaker("Unknown warnings category '$word'")}
443 }
444
445233µs ${^WARNING_BITS} = $mask ;
446}
447
448211µsmy %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
449
450sub MESSAGE () { 4 };
451sub FATAL () { 2 };
452sub NORMAL () { 1 };
453
454sub __chk
455{
456 my $category ;
457 my $offset ;
458 my $isobj = 0 ;
459 my $wanted = shift;
460 my $has_message = $wanted & MESSAGE;
461
462 unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
463 my $sub = (caller 1)[3];
464 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
465 Croaker("Usage: $sub($syntax)");
466 }
467
468 my $message = pop if $has_message;
469
470 if (@_) {
471 # check the category supplied.
472 $category = shift ;
473 if (my $type = ref $category) {
474 Croaker("not an object")
475 if exists $builtin_type{$type};
476 $category = $type;
477 $isobj = 1 ;
478 }
479 $offset = $Offsets{$category};
480 Croaker("Unknown warnings category '$category'")
481 unless defined $offset;
482 }
483 else {
484 $category = (caller(1))[0] ;
485 $offset = $Offsets{$category};
486 Croaker("package '$category' not registered for warnings")
487 unless defined $offset ;
488 }
489
490 my $i;
491
492 if ($isobj) {
493 my $pkg;
494 $i = 2;
495 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
496 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
497 }
498 $i -= 2 ;
499 }
500 else {
501 $i = _error_loc(); # see where Carp will allocate the error
502 }
503
504 # Default to 0 if caller returns nothing. Default to $DEFAULT if it
505 # explicitly returns undef.
506 my(@callers_bitmask) = (caller($i))[9] ;
507 my $callers_bitmask =
508 @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
509
510 my @results;
511 foreach my $type (FATAL, NORMAL) {
512 next unless $wanted & $type;
513
514 push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
515 vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
516 }
517
518 # &enabled and &fatal_enabled
519 return $results[0] unless $has_message;
520
521 # &warnif, and the category is neither enabled as warning nor as fatal
522 return if $wanted == (NORMAL | FATAL | MESSAGE)
523 && !($results[0] || $results[1]);
524
525 require Carp;
526 Carp::croak($message) if $results[0];
527 # will always get here for &warn. will only get here for &warnif if the
528 # category is enabled
529 Carp::carp($message);
530}
531
532sub _mkMask
533
# spent 67µs within warnings::_mkMask which was called 6 times, avg 11µs/call: # 3 times (43µs+0s) by warnings::register_categories at line 547, avg 14µs/call # 3 times (24µs+0s) by warnings::register_categories at line 553, avg 8µs/call
{
53466µs my ($bit) = @_;
53565µs my $mask = "";
536
537627µs vec($mask, $bit, 1) = 1;
538668µs return $mask;
539}
540
541sub register_categories
542
# spent 670µs (602+67) within warnings::register_categories which was called 3 times, avg 223µs/call: # 3 times (602µs+67µs) by warnings::register::import at line 43 of warnings/register.pm, avg 223µs/call
{
54336µs my @names = @_;
544
545331µs for my $name (@names) {
546317µs if (! defined $Bits{$name}) {
547318µs343µs $Bits{$name} = _mkMask($LAST_BIT);
# spent 43µs making 3 calls to warnings::_mkMask, avg 14µs/call
548314µs vec($Bits{'all'}, $LAST_BIT, 1) = 1;
54936µs $Offsets{$name} = $LAST_BIT ++;
550377µs foreach my $k (keys %Bits) {
551174378µs vec($Bits{$k}, $LAST_BIT, 1) = 0;
552 }
553315µs324µs $DeadBits{$name} = _mkMask($LAST_BIT);
# spent 24µs making 3 calls to warnings::_mkMask, avg 8µs/call
554314µs vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
555 }
556 }
557}
558
559sub _error_loc {
560 require Carp;
561 goto &Carp::short_error_loc; # don't introduce another stack frame
562}
563
564sub enabled
565{
566 return __chk(NORMAL, @_);
567}
568
569sub fatal_enabled
570{
571 return __chk(FATAL, @_);
572}
573
574sub warn
575{
576 return __chk(FATAL | MESSAGE, @_);
577}
578
579sub warnif
580{
581 return __chk(NORMAL | FATAL | MESSAGE, @_);
582}
583
584# These are not part of any public interface, so we can delete them to save
585# space.
586119µsdelete @warnings::{qw(NORMAL FATAL MESSAGE)};
587
5881117µs1;
589
590# ex: set ro:
 
# spent 24µs within warnings::CORE:match which was called: # once (24µs+0s) by Runner::BEGIN@8 at line 12
sub warnings::CORE:match; # opcode
# spent 76µs within warnings::CORE:regcomp which was called: # once (76µs+0s) by Runner::BEGIN@8 at line 12
sub warnings::CORE:regcomp; # opcode