← Index
NYTProf Performance Profile   « line view »
For -e
  Run on Thu Jun 30 16:16:00 2016
Reported on Thu Jun 30 16:16:08 2016

Filename/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/base.pm
StatementsExecuted 113 statements in 1.81ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
331137µs245µsbase::::import base::import
31176µs85µsbase::::__ANON__[:72] base::__ANON__[:72]
11130µs30µsDateTime::Infinite::::BEGIN@1DateTime::Infinite::BEGIN@1
1119µs25µsbase::::BEGIN@4 base::BEGIN@4
1119µs37µsbase::::BEGIN@5 base::BEGIN@5
3119µs9µsbase::::has_fields base::has_fields
3116µs6µsbase::::has_attr base::has_attr
3116µs6µsbase::::CORE:subst base::CORE:subst (opcode)
3111µs1µsbase::::CORE:match base::CORE:match (opcode)
0000s0sbase::::__ANON__[:49] base::__ANON__[:49]
0000s0sbase::::__ANON__[:56] base::__ANON__[:56]
0000s0sbase::::__ANON__[:64] base::__ANON__[:64]
0000s0sbase::::get_attr base::get_attr
0000s0sbase::::inherit_fields base::inherit_fields
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1268µs130µs
# spent 30µs within DateTime::Infinite::BEGIN@1 which was called: # once (30µs+0s) by DateTime::Infinite::BEGIN@11 at line 1
use 5.008;
# spent 30µs making 1 call to DateTime::Infinite::BEGIN@1
2package base;
3
4232µs240µs
# spent 25µs (9+15) within base::BEGIN@4 which was called: # once (9µs+15µs) by DateTime::Infinite::BEGIN@11 at line 4
use strict 'vars';
# spent 25µs making 1 call to base::BEGIN@4 # spent 15µs making 1 call to strict::import
521.44ms265µs
# spent 37µs (9+28) within base::BEGIN@5 which was called: # once (9µs+28µs) by DateTime::Infinite::BEGIN@11 at line 5
use vars qw($VERSION);
# spent 37µs making 1 call to base::BEGIN@5 # spent 28µs making 1 call to vars::import
61800ns$VERSION = '2.23';
712µs$VERSION =~ tr/_//d;
8
9# constant.pm is slow
10sub SUCCESS () { 1 }
11
12sub PUBLIC () { 2**0 }
13sub PRIVATE () { 2**1 }
14sub INHERITED () { 2**2 }
15sub PROTECTED () { 2**3 }
16
17
181800nsmy $Fattr = \%fields::attr;
19
20
# spent 9µs within base::has_fields which was called 3 times, avg 3µs/call: # 3 times (9µs+0s) by base::import at line 127, avg 3µs/call
sub has_fields {
2131µs my($base) = shift;
2233µs my $fglob = ${"$base\::"}{FIELDS};
2338µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
24}
25
26
# spent 6µs within base::has_attr which was called 3 times, avg 2µs/call: # 3 times (6µs+0s) by base::import at line 127, avg 2µs/call
sub has_attr {
2731µs my($proto) = shift;
2831µs my($class) = ref $proto || $proto;
2938µs return exists $Fattr->{$class};
30}
31
32sub get_attr {
33 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
34 return $Fattr->{$_[0]};
35}
36
3712µsif ($] < 5.009) {
38 *get_fields = sub {
39 # Shut up a possible typo warning.
40 () = \%{$_[0].'::FIELDS'};
41 my $f = \%{$_[0].'::FIELDS'};
42
43 # should be centralized in fields? perhaps
44 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
45 # is used here anyway, it doesn't matter.
46 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
47
48 return $f;
49 }
50}
51else {
52 *get_fields = sub {
53 # Shut up a possible typo warning.
54 () = \%{$_[0].'::FIELDS'};
55 return \%{$_[0].'::FIELDS'};
56 }
5714µs}
58
591500nsif ($] < 5.008) {
60 *_module_to_filename = sub {
61 (my $fn = $_[0]) =~ s!::!/!g;
62 $fn .= '.pm';
63 return $fn;
64 }
65}
66else {
67
# spent 85µs (76+9) within base::__ANON__[/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/base.pm:72] which was called 3 times, avg 28µs/call: # 3 times (76µs+9µs) by base::import at line 99, avg 28µs/call
*_module_to_filename = sub {
68366µs36µs (my $fn = $_[0]) =~ s!::!/!g;
# spent 6µs making 3 calls to base::CORE:subst, avg 2µs/call
6932µs $fn .= '.pm';
70312µs33µs utf8::encode($fn);
# spent 3µs making 3 calls to utf8::encode, avg 967ns/call
71310µs return $fn;
72 }
7311µs}
74
75
76
# spent 245µs (137+108) within base::import which was called 3 times, avg 82µs/call: # once (58µs+73µs) by DateTime::Infinite::BEGIN@11 at line 11 of DateTime/Infinite.pm # once (40µs+18µs) by DateTime::Infinite::Future::BEGIN@75 at line 75 of DateTime/Infinite.pm # once (39µs+17µs) by DateTime::Infinite::Past::BEGIN@100 at line 100 of DateTime/Infinite.pm
sub import {
7731µs my $class = shift;
78
7931µs return SUCCESS unless @_;
80
81 # List of base classes from which we will inherit %FIELDS.
823400ns my $fields_base;
83
8432µs my $inheritor = caller(0);
85
863600ns my @bases;
8733µs foreach my $base (@_) {
883900ns if ( $inheritor eq $base ) {
89 warn "Class '$inheritor' tried to inherit from itself\n";
90 }
91
92334µs37µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 7µs making 3 calls to UNIVERSAL::isa, avg 2µs/call
93
94 # Following blocks help isolate $SIG{__DIE__} changes
95 {
9661µs my $sigdie;
97 {
9867µs local $SIG{__DIE__};
9934µs385µs my $fn = _module_to_filename($base);
# spent 85µs making 3 calls to base::__ANON__[base.pm:72], avg 28µs/call
10064µs eval { require $fn };
101 # Only ignore "Can't locate" errors from our eval require.
102 # Other fatal errors (syntax etc) must be reported.
103 #
104 # changing the check here is fragile - if the check
105 # here isn't catching every error you want, you should
106 # probably be using parent.pm, which doesn't try to
107 # guess whether require is needed or failed,
108 # see [perl #118561]
10939µs31µs die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 1µs making 3 calls to base::CORE:match, avg 333ns/call
110 || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
11139µs unless (%{"$base\::"}) {
112 require Carp;
113 local $" = " ";
114 Carp::croak(<<ERROR);
115Base class package "$base" is empty.
116 (Perhaps you need to 'use' the module which defines that package first,
117 or make that module available in \@INC (\@INC contains: @INC).
118ERROR
119 }
120310µs $sigdie = $SIG{__DIE__} || undef;
121 }
122 # Make sure a global $SIG{__DIE__} makes it out of the localization.
12331µs $SIG{__DIE__} = $sigdie if defined $sigdie;
124 }
12532µs push @bases, $base;
126
12739µs615µs if ( has_fields($base) || has_attr($base) ) {
# spent 9µs making 3 calls to base::has_fields, avg 3µs/call # spent 6µs making 3 calls to base::has_attr, avg 2µs/call
128 # No multiple fields inheritance *suck*
129 if ($fields_base) {
130 require Carp;
131 Carp::croak("Can't multiply inherit fields");
132 } else {
133 $fields_base = $base;
134 }
135 }
136 }
137 # Save this until the end so it's all or nothing if the above loop croaks.
138328µs push @{"$inheritor\::ISA"}, @bases;
139
140312µs if( defined $fields_base ) {
141 inherit_fields($inheritor, $fields_base);
142 }
143}
144
145
146sub inherit_fields {
147 my($derived, $base) = @_;
148
149 return SUCCESS unless $base;
150
151 my $battr = get_attr($base);
152 my $dattr = get_attr($derived);
153 my $dfields = get_fields($derived);
154 my $bfields = get_fields($base);
155
156 $dattr->[0] = @$battr;
157
158 if( keys %$dfields ) {
159 warn <<"END";
160$derived is inheriting from $base but already has its own fields!
161This will cause problems. Be sure you use base BEFORE declaring fields.
162END
163
164 }
165
166 # Iterate through the base's fields adding all the non-private
167 # ones to the derived class. Hang on to the original attribute
168 # (Public, Private, etc...) and add Inherited.
169 # This is all too complicated to do efficiently with add_fields().
170 while (my($k,$v) = each %$bfields) {
171 my $fno;
172 if ($fno = $dfields->{$k} and $fno != $v) {
173 require Carp;
174 Carp::croak ("Inherited fields can't override existing fields");
175 }
176
177 if( $battr->[$v] & PRIVATE ) {
178 $dattr->[$v] = PRIVATE | INHERITED;
179 }
180 else {
181 $dattr->[$v] = INHERITED | $battr->[$v];
182 $dfields->{$k} = $v;
183 }
184 }
185
186 foreach my $idx (1..$#{$battr}) {
187 next if defined $dattr->[$idx];
188 $dattr->[$idx] = $battr->[$idx] & INHERITED;
189 }
190}
191
192
19316µs1;
194
195__END__
 
# spent 1µs within base::CORE:match which was called 3 times, avg 333ns/call: # 3 times (1µs+0s) by base::import at line 109, avg 333ns/call
sub base::CORE:match; # opcode
# spent 6µs within base::CORE:subst which was called 3 times, avg 2µs/call: # 3 times (6µs+0s) by base::__ANON__[/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/base.pm:72] at line 68, avg 2µs/call
sub base::CORE:subst; # opcode