← Index
NYTProf Performance Profile   « line view »
For -e
  Run on Thu Jun 30 16:34:56 2016
Reported on Thu Jun 30 16:35:09 2016

Filename/home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/base.pm
StatementsExecuted 113 statements in 1.17ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
331135µs192µsbase::::import base::import
31123µs33µsbase::::__ANON__[:72] base::__ANON__[:72]
11119µs19µsDateTime::Infinite::::BEGIN@1DateTime::Infinite::BEGIN@1
31110µs10µsbase::::has_fields base::has_fields
3117µs7µsbase::::CORE:subst base::CORE:subst (opcode)
1116µs29µsbase::::BEGIN@5 base::BEGIN@5
3116µs6µsbase::::has_attr base::has_attr
1116µs18µsbase::::BEGIN@4 base::BEGIN@4
3112µs2µ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
1247µs119µs
# spent 19µs within DateTime::Infinite::BEGIN@1 which was called: # once (19µs+0s) by DateTime::Infinite::BEGIN@11 at line 1
use 5.008;
# spent 19µs making 1 call to DateTime::Infinite::BEGIN@1
2package base;
3
4229µs229µs
# spent 18µs (6+12) within base::BEGIN@4 which was called: # once (6µs+12µs) by DateTime::Infinite::BEGIN@11 at line 4
use strict 'vars';
# spent 18µs making 1 call to base::BEGIN@4 # spent 12µs making 1 call to strict::import
52878µs252µs
# spent 29µs (6+23) within base::BEGIN@5 which was called: # once (6µs+23µs) by DateTime::Infinite::BEGIN@11 at line 5
use vars qw($VERSION);
# spent 29µs making 1 call to base::BEGIN@5 # spent 23µ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
1811µsmy $Fattr = \%fields::attr;
19
20
# spent 10µs within base::has_fields which was called 3 times, avg 3µs/call: # 3 times (10µs+0s) by base::import at line 127, avg 3µs/call
sub has_fields {
2132µs my($base) = shift;
2233µs my $fglob = ${"$base\::"}{FIELDS};
2337µ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;
2937µ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 }
5715µs}
58
591200nsif ($] < 5.008) {
60 *_module_to_filename = sub {
61 (my $fn = $_[0]) =~ s!::!/!g;
62 $fn .= '.pm';
63 return $fn;
64 }
65}
66else {
67
# spent 33µs (23+10) 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 11µs/call: # 3 times (23µs+10µs) by base::import at line 99, avg 11µs/call
*_module_to_filename = sub {
68317µs37µs (my $fn = $_[0]) =~ s!::!/!g;
# spent 7µs making 3 calls to base::CORE:subst, avg 2µs/call
6932µs $fn .= '.pm';
70310µs33µs utf8::encode($fn);
# spent 3µs making 3 calls to utf8::encode, avg 1µs/call
7138µs return $fn;
72 }
7311µs}
74
75
76
# spent 192µs (135+56) within base::import which was called 3 times, avg 64µs/call: # once (70µs+28µs) by DateTime::Infinite::BEGIN@11 at line 11 of DateTime/Infinite.pm # once (37µs+15µs) by DateTime::Infinite::Future::BEGIN@75 at line 75 of DateTime/Infinite.pm # once (29µs+13µs) by DateTime::Infinite::Past::BEGIN@100 at line 100 of DateTime/Infinite.pm
sub import {
7732µs my $class = shift;
78
7932µs return SUCCESS unless @_;
80
81 # List of base classes from which we will inherit %FIELDS.
823500ns my $fields_base;
83
8432µs my $inheritor = caller(0);
85
863600ns my @bases;
8732µs foreach my $base (@_) {
8831µs if ( $inheritor eq $base ) {
89 warn "Class '$inheritor' tried to inherit from itself\n";
90 }
91
92333µs36µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 6µ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 {
9866µs local $SIG{__DIE__};
9934µs333µs my $fn = _module_to_filename($base);
# spent 33µs making 3 calls to base::__ANON__[base.pm:72], avg 11µ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]
109312µs32µs die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 2µs making 3 calls to base::CORE:match, avg 567ns/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 }
120311µs $sigdie = $SIG{__DIE__} || undef;
121 }
122 # Make sure a global $SIG{__DIE__} makes it out of the localization.
1233800ns $SIG{__DIE__} = $sigdie if defined $sigdie;
124 }
12532µs push @bases, $base;
126
12738µs616µs if ( has_fields($base) || has_attr($base) ) {
# spent 10µ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.
138327µs push @{"$inheritor\::ISA"}, @bases;
139
140310µ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 2µs within base::CORE:match which was called 3 times, avg 567ns/call: # 3 times (2µs+0s) by base::import at line 109, avg 567ns/call
sub base::CORE:match; # opcode
# spent 7µs within base::CORE:subst which was called 3 times, avg 2µs/call: # 3 times (7µ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