Profile of constant.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For t/app_dpath.t
Run on Tue Jun 5 15:25:28 2012
Reported on Tue Jun 5 15:26:10 2012

Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/constant.pm
Statements | Executed 126 statements in 5.48ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
4 | 4 | 2 | 556µs | 708µs | constant::::importconstant::import
7 | 4 | 1 | 134µs | 134µs | constant::::CORE:regcompconstant::CORE:regcomp (opcode)
1 | 1 | 1 | 91µs | 91µs | constant::::BEGIN@2constant::BEGIN@2
4 | 1 | 1 | 72µs | 72µs | constant::::CORE:matchconstant::CORE:match (opcode)
1 | 1 | 1 | 51µs | 51µs | constant::::BEGIN@25constant::BEGIN@25
1 | 1 | 1 | 47µs | 457µs | constant::::BEGIN@4constant::BEGIN@4
1 | 1 | 1 | 34µs | 77µs | constant::::BEGIN@52constant::BEGIN@52
1 | 1 | 1 | 32µs | 52µs | constant::::BEGIN@3constant::BEGIN@3
1 | 1 | 1 | 31µs | 179µs | constant::::BEGIN@6constant::BEGIN@6
1 | 1 | 1 | 30µs | 88µs | constant::::BEGIN@114constant::BEGIN@114
1 | 1 | 1 | 28µs | 80µs | constant::::BEGIN@29constant::BEGIN@29
3 | 3 | 1 | 19µs | 19µs | constant::::CORE:qrconstant::CORE:qr (opcode)
0 | 0 | 0 | 0s | 0s | constant::::__ANON__[:136]constant::__ANON__[:136]
0 | 0 | 0 | 0s | 0s | constant::::__ANON__[:140]constant::__ANON__[:140]
0 | 0 | 0 | 0s | 0s | constant::::__ANON__[:142]constant::__ANON__[:142]
0 | 0 | 0 | 0s | 0s | constant::::__ANON__[:31]constant::__ANON__[:31]

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package constant;
2 | 2 | 201µs | 1 | 91µs | # spent 91µs within constant::BEGIN@2 which was called: # once (91µs+0s) by JSON::Backend::XS::BEGIN@9 at line 2 use 5.005; # spent 91µs making 1 call to constant::BEGIN@2
3 | 2 | 107µs | 2 | 71µs | # spent 52µs (32+20) within constant::BEGIN@3 which was called: # once (32µs+20µs) by JSON::Backend::XS::BEGIN@9 at line 3 use strict; # spent 52µs making 1 call to constant::BEGIN@3 # spent 20µs making 1 call to strict::import
4 | 2 | 119µs | 2 | 867µs | # spent 457µs (47+410) within constant::BEGIN@4 which was called: # once (47µs+410µs) by JSON::Backend::XS::BEGIN@9 at line 4 use warnings::register; # spent 457µs making 1 call to constant::BEGIN@4 # spent 410µs making 1 call to warnings::register::import
5 |  |  |  |  |
6 | 2 | 570µs | 2 | 327µs | # spent 179µs (31+148) within constant::BEGIN@6 which was called: # once (31µs+148µs) by JSON::Backend::XS::BEGIN@9 at line 6 use vars qw($VERSION %declared); # spent 179µs making 1 call to constant::BEGIN@6 # spent 148µs making 1 call to vars::import
7 | 1 | 4µs |  |  | $VERSION = '1.21';
8 |  |  |  |  |
9 |  |  |  |  | #=======================================================================
10 |  |  |  |  |
11 |  |  |  |  | # Some names are evil choices.
12 | 1 | 26µs |  |  | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
13 | 1 | 15µs |  |  | $keywords{UNITCHECK}++ if $] > 5.009;
14 |  |  |  |  |
15 | 1 | 21µs |  |  | my %forced_into_main = map +($_, 1),
16 |  |  |  |  | qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
17 |  |  |  |  |
18 | 1 | 21µs |  |  | my %forbidden = (%keywords, %forced_into_main);
19 |  |  |  |  |
20 | 1 | 4µs |  |  | my $str_end = $] >= 5.006 ? "\\z" : "\\Z";
21 | 1 | 133µs | 2 | 84µs | my $normal_constant_name = qr/^_?[^\W_0-9]\w*$str_end/; # spent 74µs making 1 call to constant::CORE:regcomp # spent 10µs making 1 call to constant::CORE:qr
22 | 1 | 41µs | 2 | 24µs | my $tolerable = qr/^[A-Za-z_]\w*$str_end/; # spent 19µs making 1 call to constant::CORE:regcomp # spent 4µs making 1 call to constant::CORE:qr
23 | 1 | 41µs | 2 | 24µs | my $boolean = qr/^[01]?$str_end/; # spent 20µs making 1 call to constant::CORE:regcomp # spent 4µs making 1 call to constant::CORE:qr
24 |  |  |  |  |
25 |  |  |  |  | # spent 51µs within constant::BEGIN@25 which was called: # once (51µs+0s) by JSON::Backend::XS::BEGIN@9 at line 32 BEGIN {
26 |  |  |  |  | # We'd like to do use constant _CAN_PCS => $] > 5.009002
27 |  |  |  |  | # but that's a bit tricky before we load the constant module :-)
28 |  |  |  |  | # By doing this, we save 1 run time check for *every* call to import.
29 | 2 | 315µs | 2 | 132µs | # spent 80µs (28+52) within constant::BEGIN@29 which was called: # once (28µs+52µs) by JSON::Backend::XS::BEGIN@9 at line 29 no strict 'refs'; # spent 80µs making 1 call to constant::BEGIN@29 # spent 52µs making 1 call to strict::unimport
30 | 1 | 6µs |  |  | my $const = $] > 5.009002;
31 | 1 | 48µs |  |  | *_CAN_PCS = sub () {$const};
32 | 1 | 295µs | 1 | 51µs | } # spent 51µs making 1 call to constant::BEGIN@25
33 |  |  |  |  |
34 |  |  |  |  | #=======================================================================
35 |  |  |  |  | # import() - import symbols into user's namespace
36 |  |  |  |  | #
37 |  |  |  |  | # What we actually do is define a function in the caller's namespace
38 |  |  |  |  | # which returns the value. The function we create will normally
39 |  |  |  |  | # be inlined as a constant, thereby avoiding further sub calling
40 |  |  |  |  | # overhead.
41 |  |  |  |  | #=======================================================================
42 |  |  |  |  | # spent 708µs (556+153) within constant::import which was called 4 times, avg 177µs/call: # once (246µs+60µs) by JSON::Backend::XS::BEGIN@9 at line 9 of (eval 12)[JSON.pm:268] # once (132µs+44µs) by YAML::Syck::BEGIN@36 at line 53 of YAML/Syck.pm # once (92µs+26µs) by JSON::Backend::XS::BEGIN@11 at line 11 of (eval 12)[JSON.pm:268] # once (86µs+23µs) by JSON::Backend::XS::BEGIN@18 at line 18 of (eval 12)[JSON.pm:268] sub import {
43 | 4 | 9µs |  |  | my $class = shift;
44 | 4 | 8µs |  |  | return unless @_; # Ignore 'use constant;'
45 | 4 | 3µs |  |  | my $constants;
46 | 4 | 8µs |  |  | my $multiple = ref $_[0];
47 | 4 | 8µs |  |  | my $pkg = caller;
48 | 4 | 2µs |  |  | my $flush_mro;
49 | 4 | 2µs |  |  | my $symtab;
50 |  |  |  |  |
51 | 4 | 8µs |  |  | if (_CAN_PCS) {
52 | 2 | 1.21ms | 2 | 119µs | # spent 77µs (34+42) within constant::BEGIN@52 which was called: # once (34µs+42µs) by JSON::Backend::XS::BEGIN@9 at line 52 no strict 'refs'; # spent 77µs making 1 call to constant::BEGIN@52 # spent 42µs making 1 call to strict::unimport
53 | 4 | 26µs |  |  | $symtab = \%{$pkg . '::'};
54 |  |  |  |  | };
55 |  |  |  |  |
56 | 4 | 6µs |  |  | if ( $multiple ) {
57 |  |  |  |  | if (ref $_[0] ne 'HASH') {
58 |  |  |  |  | require Carp;
59 |  |  |  |  | Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'");
60 |  |  |  |  | }
61 |  |  |  |  | $constants = shift;
62 |  |  |  |  | } else {
63 | 4 | 6µs |  |  | unless (defined $_[0]) {
64 |  |  |  |  | require Carp;
65 |  |  |  |  | Carp::croak("Can't use undef as constant name");
66 |  |  |  |  | }
67 | 4 | 22µs |  |  | $constants->{+shift} = undef;
68 |  |  |  |  | }
69 |  |  |  |  |
70 | 4 | 30µs |  |  | foreach my $name ( keys %$constants ) {
71 |  |  |  |  | # Normal constant name
72 | 4 | 171µs | 8 | 93µs | if ($name =~ $normal_constant_name and !$forbidden{$name}) { # spent 72µs making 4 calls to constant::CORE:match, avg 18µs/call # spent 21µs making 4 calls to constant::CORE:regcomp, avg 5µs/call
73 |  |  |  |  | # Everything is okay
74 |  |  |  |  |
75 |  |  |  |  | # Name forced into main, but we're not in main. Fatal.
76 |  |  |  |  | } elsif ($forced_into_main{$name} and $pkg ne 'main') {
77 |  |  |  |  | require Carp;
78 |  |  |  |  | Carp::croak("Constant name '$name' is forced into main::");
79 |  |  |  |  |
80 |  |  |  |  | # Starts with double underscore. Fatal.
81 |  |  |  |  | } elsif ($name =~ /^__/) {
82 |  |  |  |  | require Carp;
83 |  |  |  |  | Carp::croak("Constant name '$name' begins with '__'");
84 |  |  |  |  |
85 |  |  |  |  | # Maybe the name is tolerable
86 |  |  |  |  | } elsif ($name =~ $tolerable) {
87 |  |  |  |  | # Then we'll warn only if you've asked for warnings
88 |  |  |  |  | if (warnings::enabled()) {
89 |  |  |  |  | if ($keywords{$name}) {
90 |  |  |  |  | warnings::warn("Constant name '$name' is a Perl keyword");
91 |  |  |  |  | } elsif ($forced_into_main{$name}) {
92 |  |  |  |  | warnings::warn("Constant name '$name' is " .
93 |  |  |  |  | "forced into package main::");
94 |  |  |  |  | }
95 |  |  |  |  | }
96 |  |  |  |  |
97 |  |  |  |  | # Looks like a boolean
98 |  |  |  |  | # use constant FRED == fred;
99 |  |  |  |  | } elsif ($name =~ $boolean) {
100 |  |  |  |  | require Carp;
101 |  |  |  |  | if (@_) {
102 |  |  |  |  | Carp::croak("Constant name '$name' is invalid");
103 |  |  |  |  | } else {
104 |  |  |  |  | Carp::croak("Constant name looks like boolean value");
105 |  |  |  |  | }
106 |  |  |  |  |
107 |  |  |  |  | } else {
108 |  |  |  |  | # Must have bad characters
109 |  |  |  |  | require Carp;
110 |  |  |  |  | Carp::croak("Constant name '$name' has invalid characters");
111 |  |  |  |  | }
112 |  |  |  |  |
113 |  |  |  |  | {
114 | 6 | 1.56ms | 2 | 146µs | # spent 88µs (30+58) within constant::BEGIN@114 which was called: # once (30µs+58µs) by JSON::Backend::XS::BEGIN@9 at line 114 no strict 'refs'; # spent 88µs making 1 call to constant::BEGIN@114 # spent 58µs making 1 call to strict::unimport
115 | 4 | 16µs |  |  | my $full_name = "${pkg}::$name";
116 | 4 | 14µs |  |  | $declared{$full_name}++;
117 | 4 | 15µs |  |  | if ($multiple || @_ == 1) {
118 | 4 | 6µs |  |  | my $scalar = $multiple ? $constants->{$name} : $_[0];
119 |  |  |  |  |
120 |  |  |  |  | # Work around perl bug #xxxxx: Sub names (actually glob
121 |  |  |  |  | # names in general) ignore the UTF8 flag. So we have to
122 |  |  |  |  | # turn it off to get the "right" symbol table entry.
123 | 4 | 140µs | 4 | 18µs | utf8::is_utf8 $name and utf8::encode $name; # spent 18µs making 4 calls to utf8::is_utf8, avg 4µs/call
124 |  |  |  |  |
125 |  |  |  |  | # The constant serves to optimise this entire block out on
126 |  |  |  |  | # 5.8 and earlier.
127 | 4 | 15µs |  |  | if (_CAN_PCS && $symtab && !exists $symtab->{$name}) {
128 |  |  |  |  | # No typeglob yet, so we can use a reference as space-
129 |  |  |  |  | # efficient proxy for a constant subroutine
130 |  |  |  |  | # The check in Perl_ck_rvconst knows that inlinable
131 |  |  |  |  | # constants from cv_const_sv are read only. So we have to:
132 | 4 | 55µs | 4 | 15µs | Internals::SvREADONLY($scalar, 1); # spent 15µs making 4 calls to Internals::SvREADONLY, avg 4µs/call
133 | 4 | 12µs |  |  | $symtab->{$name} = \$scalar;
134 | 4 | 6µs |  |  | ++$flush_mro;
135 |  |  |  |  | } else {
136 |  |  |  |  | *$full_name = sub () { $scalar };
137 |  |  |  |  | }
138 |  |  |  |  | } elsif (@_) {
139 |  |  |  |  | my @list = @_;
140 |  |  |  |  | *$full_name = sub () { @list };
141 |  |  |  |  | } else {
142 |  |  |  |  | *$full_name = sub () { };
143 |  |  |  |  | }
144 |  |  |  |  | }
145 |  |  |  |  | }
146 |  |  |  |  | # Flush the cache exactly once if we make any direct symbol table changes.
147 | 4 | 119µs | 4 | 27µs | mro::method_changed_in($pkg) if _CAN_PCS && $flush_mro; # spent 27µs making 4 calls to mro::method_changed_in, avg 7µs/call
148 |  |  |  |  | }
149 |  |  |  |  |
150 | 1 | 44µs |  |  | 1;
151 |  |  |  |  |
152 |  |  |  |  | __END__
|  |  |  |  | # spent 72µs within constant::CORE:match which was called 4 times, avg 18µs/call: # 4 times (72µs+0s) by constant::import at line 72, avg 18µs/call sub constant::CORE:match; # opcode
|  |  |  |  | # spent 19µs within constant::CORE:qr which was called 3 times, avg 6µs/call: # once (10µs+0s) by JSON::Backend::XS::BEGIN@9 at line 21 # once (4µs+0s) by JSON::Backend::XS::BEGIN@9 at line 22 # once (4µs+0s) by JSON::Backend::XS::BEGIN@9 at line 23 sub constant::CORE:qr; # opcode
|  |  |  |  | # spent 134µs within constant::CORE:regcomp which was called 7 times, avg 19µs/call: # 4 times (21µs+0s) by constant::import at line 72, avg 5µs/call # once (74µs+0s) by JSON::Backend::XS::BEGIN@9 at line 21 # once (20µs+0s) by JSON::Backend::XS::BEGIN@9 at line 23 # once (19µs+0s) by JSON::Backend::XS::BEGIN@9 at line 22 sub constant::CORE:regcomp; # opcode