← Index
NYTProf Performance Profile   « line view »
For t/optimization.t
  Run on Thu Jan 8 22:47:42 2015
Reported on Thu Jan 8 22:48:06 2015

Filename/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/base.pm
StatementsExecuted 496 statements in 2.29ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1818141.41ms1.61msbase::::importbase::import
181176µs76µsbase::::has_fieldsbase::has_fields
181152µs52µsbase::::has_attrbase::has_attr
71129µs29µsbase::::CORE:matchbase::CORE:match (opcode)
11116µs28µsbase::::BEGIN@3base::BEGIN@3
1118µs32µsbase::::BEGIN@4base::BEGIN@4
0000s0sbase::::__ANON__[:48]base::__ANON__[:48]
0000s0sbase::::__ANON__[:55]base::__ANON__[:55]
0000s0sbase::::get_attrbase::get_attr
0000s0sbase::::inherit_fieldsbase::inherit_fields
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package base;
2
3228µs241µs
# spent 28µs (16+13) within base::BEGIN@3 which was called: # once (16µs+13µs) by Iterator::Util::BEGIN@20 at line 3
use strict 'vars';
# spent 28µs making 1 call to base::BEGIN@3 # spent 13µs making 1 call to strict::import
42780µs256µs
# spent 32µs (8+24) within base::BEGIN@4 which was called: # once (8µs+24µs) by Iterator::Util::BEGIN@20 at line 4
use vars qw($VERSION);
# spent 32µs making 1 call to base::BEGIN@4 # spent 24µs making 1 call to vars::import
51700ns$VERSION = '2.18';
6115µs$VERSION = eval $VERSION;
# spent 2µs executing statements in string eval
7
8# constant.pm is slow
9sub SUCCESS () { 1 }
10
11sub PUBLIC () { 2**0 }
12sub PRIVATE () { 2**1 }
13sub INHERITED () { 2**2 }
14sub PROTECTED () { 2**3 }
15
16
1711µsmy $Fattr = \%fields::attr;
18
19
# spent 76µs within base::has_fields which was called 18 times, avg 4µs/call: # 18 times (76µs+0s) by base::import at line 101, avg 4µs/call
sub has_fields {
201813µs my($base) = shift;
211823µs my $fglob = ${"$base\::"}{FIELDS};
221869µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
23}
24
25
# spent 52µs within base::has_attr which was called 18 times, avg 3µs/call: # 18 times (52µs+0s) by base::import at line 101, avg 3µs/call
sub has_attr {
26189µs my($proto) = shift;
27189µs my($class) = ref $proto || $proto;
281854µs return exists $Fattr->{$class};
29}
30
31sub get_attr {
32 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
33 return $Fattr->{$_[0]};
34}
35
3611µsif ($] < 5.009) {
37 *get_fields = sub {
38 # Shut up a possible typo warning.
39 () = \%{$_[0].'::FIELDS'};
40 my $f = \%{$_[0].'::FIELDS'};
41
42 # should be centralized in fields? perhaps
43 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
44 # is used here anyway, it doesn't matter.
45 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
46
47 return $f;
48 }
49}
50else {
51 *get_fields = sub {
52 # Shut up a possible typo warning.
53 () = \%{$_[0].'::FIELDS'};
54 return \%{$_[0].'::FIELDS'};
55 }
5613µs}
57
58
# spent 1.61ms (1.41+199µs) within base::import which was called 18 times, avg 89µs/call: # once (109µs+16µs) by Test::Deep::SuperHashKeysOnly::BEGIN@100 at line 100 of Test/Deep/HashKeysOnly.pm # once (103µs+14µs) by Test::Deep::SubHashKeysOnly::BEGIN@114 at line 114 of Test/Deep/HashKeysOnly.pm # once (98µs+13µs) by Iterator::X::IO_Error::BEGIN@3 at line 3 of (eval 18)[Exception/Class.pm:180] # once (94µs+12µs) by Iterator::X::User_Code_Error::BEGIN@3 at line 3 of (eval 28)[Exception/Class.pm:180] # once (83µs+12µs) by Iterator::X::Am_Now_Exhausted::BEGIN@3 at line 3 of (eval 30)[Exception/Class.pm:180] # once (83µs+11µs) by Iterator::X::Internal_Error::BEGIN@3 at line 3 of (eval 24)[Exception/Class.pm:180] # once (81µs+12µs) by Iterator::X::Exhausted::BEGIN@3 at line 3 of (eval 20)[Exception/Class.pm:180] # once (80µs+13µs) by Test::Deep::SuperHashElements::BEGIN@70 at line 70 of Test/Deep/HashElements.pm # once (79µs+11µs) by Iterator::X::OptionError::BEGIN@3 at line 3 of (eval 22)[Exception/Class.pm:180] # once (76µs+12µs) by Iterator::X::Parameter_Error::BEGIN@3 at line 3 of (eval 26)[Exception/Class.pm:180] # once (73µs+12µs) by Test::Deep::SuperHash::BEGIN@60 at line 60 of Test/Deep/Hash.pm # once (69µs+10µs) by Iterator::Util::BEGIN@20 at line 20 of Iterator/Util.pm # once (67µs+9µs) by Iterator::X::BEGIN@3 at line 3 of (eval 16)[Exception/Class.pm:180] # once (65µs+10µs) by Exception::Class::Base::BEGIN@13 at line 13 of Exception/Class/Base.pm # once (66µs+8µs) by Test::Deep::SuperHashKeys::BEGIN@42 at line 42 of Test/Deep/HashKeys.pm # once (61µs+9µs) by Test::Deep::SubHashElements::BEGIN@83 at line 83 of Test/Deep/HashElements.pm # once (61µs+8µs) by Test::Deep::SubHash::BEGIN@83 at line 83 of Test/Deep/Hash.pm # once (60µs+8µs) by Test::Deep::SubHashKeys::BEGIN@56 at line 56 of Test/Deep/HashKeys.pm
sub import {
591810µs my $class = shift;
60
61187µs return SUCCESS unless @_;
62
63 # List of base classes from which we will inherit %FIELDS.
64183µs my $fields_base;
65
661816µs my $inheritor = caller(0);
67
68185µs my @bases;
691820µs foreach my $base (@_) {
70187µs if ( $inheritor eq $base ) {
71 warn "Class '$inheritor' tried to inherit from itself\n";
72 }
73
7418225µs1842µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 42µs making 18 calls to UNIVERSAL::isa, avg 2µs/call
75
76 # Following blocks help isolate $SIG{__DIE__} changes
77 {
783611µs my $sigdie;
79 {
803651µs local $SIG{__DIE__};
8118376µs eval "require $base";
# spent 170µs executing statements in 7 string evals (merged) # spent 8µs executing statements in 2 string evals (merged) # spent 5µs executing statements in 2 string evals (merged) # spent 5µs executing statements in 2 string evals (merged) # spent 5µs executing statements in 2 string evals (merged) # spent 3µs executing statements in string eval # spent 2µs executing statements in string eval # spent 2µs executing statements in string eval
82 # Only ignore "Can't locate" errors from our eval require.
83 # Other fatal errors (syntax etc) must be reported.
841860µs729µs die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
# spent 29µs making 7 calls to base::CORE:match, avg 4µs/call
851848µs unless (%{"$base\::"}) {
86 require Carp;
87 local $" = " ";
88 Carp::croak(<<ERROR);
89Base class package "$base" is empty.
90 (Perhaps you need to 'use' the module which defines that package first,
91 or make that module available in \@INC (\@INC contains: @INC).
92ERROR
93 }
941861µs $sigdie = $SIG{__DIE__} || undef;
95 }
96 # Make sure a global $SIG{__DIE__} makes it out of the localization.
97188µs $SIG{__DIE__} = $sigdie if defined $sigdie;
98 }
991815µs push @bases, $base;
100
1011877µs36127µs if ( has_fields($base) || has_attr($base) ) {
# spent 76µs making 18 calls to base::has_fields, avg 4µs/call # spent 52µs making 18 calls to base::has_attr, avg 3µs/call
102 # No multiple fields inheritance *suck*
103 if ($fields_base) {
104 require Carp;
105 Carp::croak("Can't multiply inherit fields");
106 } else {
107 $fields_base = $base;
108 }
109 }
110 }
111 # Save this until the end so it's all or nothing if the above loop croaks.
11218190µs push @{"$inheritor\::ISA"}, @bases;
113
1141894µs if( defined $fields_base ) {
115 inherit_fields($inheritor, $fields_base);
116 }
117}
118
119
120sub inherit_fields {
121 my($derived, $base) = @_;
122
123 return SUCCESS unless $base;
124
125 my $battr = get_attr($base);
126 my $dattr = get_attr($derived);
127 my $dfields = get_fields($derived);
128 my $bfields = get_fields($base);
129
130 $dattr->[0] = @$battr;
131
132 if( keys %$dfields ) {
133 warn <<"END";
134$derived is inheriting from $base but already has its own fields!
135This will cause problems. Be sure you use base BEFORE declaring fields.
136END
137
138 }
139
140 # Iterate through the base's fields adding all the non-private
141 # ones to the derived class. Hang on to the original attribute
142 # (Public, Private, etc...) and add Inherited.
143 # This is all too complicated to do efficiently with add_fields().
144 while (my($k,$v) = each %$bfields) {
145 my $fno;
146 if ($fno = $dfields->{$k} and $fno != $v) {
147 require Carp;
148 Carp::croak ("Inherited fields can't override existing fields");
149 }
150
151 if( $battr->[$v] & PRIVATE ) {
152 $dattr->[$v] = PRIVATE | INHERITED;
153 }
154 else {
155 $dattr->[$v] = INHERITED | $battr->[$v];
156 $dfields->{$k} = $v;
157 }
158 }
159
160 foreach my $idx (1..$#{$battr}) {
161 next if defined $dattr->[$idx];
162 $dattr->[$idx] = $battr->[$idx] & INHERITED;
163 }
164}
165
166
16715µs1;
168
169__END__
 
# spent 29µs within base::CORE:match which was called 7 times, avg 4µs/call: # 7 times (29µs+0s) by base::import at line 84, avg 4µs/call
sub base::CORE:match; # opcode