← Index
Performance Profile   « block view • line view • sub view »
For walkoptree.pl
  Run on Fri Apr 17 10:24:39 2009
Reported on Fri Apr 17 10:25:16 2009

File C:/usr/lib/warnings.pm
Statements Executed 28
Total Time 0.015625 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
0000s0swarnings::::BEGINwarnings::BEGIN
0000s0swarnings::::Croakerwarnings::Croaker
0000s0swarnings::::__chkwarnings::__chk
0000s0swarnings::::bitswarnings::bits
0000s0swarnings::::enabledwarnings::enabled
1110s0swarnings::::importwarnings::import
0000s0swarnings::::unimportwarnings::unimport
0000s0swarnings::::warnwarnings::warn
0000s0swarnings::::warnifwarnings::warnif
LineStmts.Exclusive
Time		Avg.Code
1# -*- buffer-read-only: t -*-
2# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
3# This file was created by warnings.pl
4# Any changes made here will be lost.
5#
6
7package warnings;
8
910s0sour $VERSION = '1.05';
10
11=head1 NAME
12
13warnings - Perl pragma to control optional warnings
14
15=head1 SYNOPSIS
16
17 use warnings;
18 no warnings;
19
20 use warnings "all";
21 no warnings "all";
22
23 use warnings::register;
24 if (warnings::enabled()) {
25 warnings::warn("some warning");
26 }
27
28 if (warnings::enabled("void")) {
29 warnings::warn("void", "some warning");
30 }
31
32 if (warnings::enabled($object)) {
33 warnings::warn($object, "some warning");
34 }
35
36 warnings::warnif("some warning");
37 warnings::warnif("void", "some warning");
38 warnings::warnif($object, "some warning");
39
40=head1 DESCRIPTION
41
42The C<warnings> pragma is a replacement for the command line flag C<-w>,
43but the pragma is limited to the enclosing block, while the flag is global.
44See L<perllexwarn> for more information.
45
46If no import list is supplied, all possible warnings are either enabled
47or disabled.
48
49A number of functions are provided to assist module authors.
50
51=over 4
52
53=item use warnings::register
54
55Creates a new warnings category with the same name as the package where
56the call to the pragma is used.
57
58=item warnings::enabled()
59
60Use the warnings category with the same name as the current package.
61
62Return TRUE if that warnings category is enabled in the calling module.
63Otherwise returns FALSE.
64
65=item warnings::enabled($category)
66
67Return TRUE if the warnings category, C<$category>, is enabled in the
68calling module.
69Otherwise returns FALSE.
70
71=item warnings::enabled($object)
72
73Use the name of the class for the object reference, C<$object>, as the
74warnings category.
75
76Return TRUE if that warnings category is enabled in the first scope
77where the object is used.
78Otherwise returns FALSE.
79
80=item warnings::warn($message)
81
82Print C<$message> to STDERR.
83
84Use the warnings category with the same name as the current package.
85
86If that warnings category has been set to "FATAL" in the calling module
87then die. Otherwise return.
88
89=item warnings::warn($category, $message)
90
91Print C<$message> to STDERR.
92
93If the warnings category, C<$category>, has been set to "FATAL" in the
94calling module then die. Otherwise return.
95
96=item warnings::warn($object, $message)
97
98Print C<$message> to STDERR.
99
100Use the name of the class for the object reference, C<$object>, as the
101warnings category.
102
103If that warnings category has been set to "FATAL" in the scope where C<$object>
104is first used then die. Otherwise return.
105
106
107=item warnings::warnif($message)
108
109Equivalent to:
110
111 if (warnings::enabled())
112 { warnings::warn($message) }
113
114=item warnings::warnif($category, $message)
115
116Equivalent to:
117
118 if (warnings::enabled($category))
119 { warnings::warn($category, $message) }
120
121=item warnings::warnif($object, $message)
122
123Equivalent to:
124
125 if (warnings::enabled($object))
126 { warnings::warn($object, $message) }
127
128=back
129
130See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
131
132=cut
133
134315.6ms5.21msuse Carp ();
135
13610s0sour %Offsets = (
137
138 # Warnings Categories added in Perl 5.008
139
140 'all' => 0,
141 'closure' => 2,
142 'deprecated' => 4,
143 'exiting' => 6,
144 'glob' => 8,
145 'io' => 10,
146 'closed' => 12,
147 'exec' => 14,
148 'layer' => 16,
149 'newline' => 18,
150 'pipe' => 20,
151 'unopened' => 22,
152 'misc' => 24,
153 'numeric' => 26,
154 'once' => 28,
155 'overflow' => 30,
156 'pack' => 32,
157 'portable' => 34,
158 'recursion' => 36,
159 'redefine' => 38,
160 'regexp' => 40,
161 'severe' => 42,
162 'debugging' => 44,
163 'inplace' => 46,
164 'internal' => 48,
165 'malloc' => 50,
166 'signal' => 52,
167 'substr' => 54,
168 'syntax' => 56,
169 'ambiguous' => 58,
170 'bareword' => 60,
171 'digit' => 62,
172 'parenthesis' => 64,
173 'precedence' => 66,
174 'printf' => 68,
175 'prototype' => 70,
176 'qw' => 72,
177 'reserved' => 74,
178 'semicolon' => 76,
179 'taint' => 78,
180 'threads' => 80,
181 'uninitialized' => 82,
182 'unpack' => 84,
183 'untie' => 86,
184 'utf8' => 88,
185 'void' => 90,
186 'y2k' => 92,
187 );
188
18910s0sour %Bits = (
190 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
191 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
192 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
193 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
194 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
195 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
196 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
197 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
198 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
199 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
200 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
201 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
202 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
203 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
204 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
205 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
206 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
207 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
208 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
209 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
210 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
211 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
212 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
213 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
214 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
215 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
216 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
217 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
218 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
219 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
220 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
221 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
222 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
223 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
224 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
225 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
226 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
227 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
228 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
229 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
230 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
231 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
232 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
233 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
234 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
235 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
236 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
237 );
238
23910s0sour %DeadBits = (
240 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
241 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
242 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
243 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
244 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
245 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
246 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
247 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
248 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
249 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
250 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
251 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
252 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
253 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
254 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
255 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
256 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
257 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
258 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
259 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
260 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
261 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
262 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
263 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
264 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
265 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
266 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
267 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
268 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
269 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
270 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
271 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
272 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
273 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
274 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
275 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
276 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
277 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
278 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
279 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
280 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
281 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
282 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
283 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
284 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
285 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
286 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
287 );
288
28910s0s$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
29010s0s$LAST_BIT = 94 ;
29110s0s$BYTES = 12 ;
292
29320s0s$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
294
295sub Croaker
296{
297 require Carp::Heavy; # this initializes %CarpInternal
298 delete $Carp::CarpInternal{'warnings'};
299 Carp::croak(@_);
300}
301
302sub bits
303{
304 # called from B::Deparse.pm
305
306 push @_, 'all' unless @_;
307
308 my $mask;
309 my $catmask ;
310 my $fatal = 0 ;
311 my $no_fatal = 0 ;
312
313 foreach my $word ( @_ ) {
314 if ($word eq 'FATAL') {
315 $fatal = 1;
316 $no_fatal = 0;
317 }
318 elsif ($word eq 'NONFATAL') {
319 $fatal = 0;
320 $no_fatal = 1;
321 }
322 elsif ($catmask = $Bits{$word}) {
323 $mask |= $catmask ;
324 $mask |= $DeadBits{$word} if $fatal ;
325 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
326 }
327 else
328 { Croaker("Unknown warnings category '$word'")}
329 }
330
331 return $mask ;
332}
333
334sub import
335
# spent 0s within warnings::import which was called # once (0s+0s) at line 4 of C:/Dokumente und Einstellungen/Entwicklung/Eigene Dateien/Perl/community/walkoptree.pl
{
33690s0s shift;
337
338 my $catmask ;
339 my $fatal = 0 ;
340 my $no_fatal = 0 ;
341
342 my $mask = ${^WARNING_BITS} ;
343
344 if (vec($mask, $Offsets{'all'}, 1)) {
345 $mask |= $Bits{'all'} ;
346 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
347 }
348
349 push @_, 'all' unless @_;
350
351 foreach my $word ( @_ ) {
35240s0s if ($word eq 'FATAL') {
353 $fatal = 1;
354 $no_fatal = 0;
355 }
356 elsif ($word eq 'NONFATAL') {
357 $fatal = 0;
358 $no_fatal = 1;
359 }
360 elsif ($catmask = $Bits{$word}) {
361 $mask |= $catmask ;
362 $mask |= $DeadBits{$word} if $fatal ;
363 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
364 }
365 else
366 { Croaker("Unknown warnings category '$word'")}
367 }
368
369 ${^WARNING_BITS} = $mask ;
370}
371
372sub unimport
373{
374 shift;
375
376 my $catmask ;
377 my $mask = ${^WARNING_BITS} ;
378
379 if (vec($mask, $Offsets{'all'}, 1)) {
380 $mask |= $Bits{'all'} ;
381 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
382 }
383
384 push @_, 'all' unless @_;
385
386 foreach my $word ( @_ ) {
387 if ($word eq 'FATAL') {
388 next;
389 }
390 elsif ($catmask = $Bits{$word}) {
391 $mask &= ~($catmask | $DeadBits{$word} | $All);
392 }
393 else
394 { Croaker("Unknown warnings category '$word'")}
395 }
396
397 ${^WARNING_BITS} = $mask ;
398}
399
40020s0smy %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
401
402sub __chk
403{
404 my $category ;
405 my $offset ;
406 my $isobj = 0 ;
407
408 if (@_) {
409 # check the category supplied.
410 $category = shift ;
411 if (my $type = ref $category) {
412 Croaker("not an object")
413 if exists $builtin_type{$type};
414 $category = $type;
415 $isobj = 1 ;
416 }
417 $offset = $Offsets{$category};
418 Croaker("Unknown warnings category '$category'")
419 unless defined $offset;
420 }
421 else {
422 $category = (caller(1))[0] ;
423 $offset = $Offsets{$category};
424 Croaker("package '$category' not registered for warnings")
425 unless defined $offset ;
426 }
427
428 my $this_pkg = (caller(1))[0] ;
429 my $i = 2 ;
430 my $pkg ;
431
432 if ($isobj) {
433 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
434 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
435 }
436 $i -= 2 ;
437 }
438 else {
439 for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
440 last if $pkg ne $this_pkg ;
441 }
442 $i = 2
443 if !$pkg || $pkg eq $this_pkg ;
444 }
445
446 my $callers_bitmask = (caller($i))[9] ;
447 return ($callers_bitmask, $offset, $i) ;
448}
449
450sub enabled
451{
452 Croaker("Usage: warnings::enabled([category])")
453 unless @_ == 1 || @_ == 0 ;
454
455 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
456
457 return 0 unless defined $callers_bitmask ;
458 return vec($callers_bitmask, $offset, 1) ||
459 vec($callers_bitmask, $Offsets{'all'}, 1) ;
460}
461
462
463sub warn
464{
465 Croaker("Usage: warnings::warn([category,] 'message')")
466 unless @_ == 2 || @_ == 1 ;
467
468 my $message = pop ;
469 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
470 Carp::croak($message)
471 if vec($callers_bitmask, $offset+1, 1) ||
472 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
473 Carp::carp($message) ;
474}
475
476sub warnif
477{
478 Croaker("Usage: warnings::warnif([category,] 'message')")
479 unless @_ == 2 || @_ == 1 ;
480
481 my $message = pop ;
482 my ($callers_bitmask, $offset, $i) = __chk(@_) ;
483
484 return
485 unless defined $callers_bitmask &&
486 (vec($callers_bitmask, $offset, 1) ||
487 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
488
489 Carp::croak($message)
490 if vec($callers_bitmask, $offset+1, 1) ||
491 vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
492
493 Carp::carp($message) ;
494}
495
49610s0s1;
497# ex: set ro:
Report produced by the NYTProf 2.08 Perl profiler, developed by Tim Bunce and Adam Kaplan.