← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:57:08 2022
Reported on Wed Dec 14 16:00:30 2022

Filename/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/base.pm
StatementsExecuted 493 statements in 3.21ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1313111.12ms1.60msbase::::import base::import
211150µs150µsbase::::CORE:regcomp base::CORE:regcomp (opcode)
1311114µs182µsbase::::__ANON__[:76] base::__ANON__[:76]
131157µs57µsbase::::has_fields base::has_fields
131146µs46µsbase::::CORE:subst base::CORE:subst (opcode)
131130µs30µsbase::::has_attr base::has_attr
151126µs26µsbase::::CORE:match base::CORE:match (opcode)
11118µs18µsJSON::MaybeXS::::BEGIN@1 JSON::MaybeXS::BEGIN@1
1114µs10µsbase::::BEGIN@4 base::BEGIN@4
0000s0sbase::::__ANON__[:133] base::__ANON__[:133]
0000s0sbase::::__ANON__[:134] base::__ANON__[:134]
0000s0sbase::::__ANON__[:53] base::__ANON__[:53]
0000s0sbase::::__ANON__[:60] base::__ANON__[:60]
0000s0sbase::::__ANON__[:68] base::__ANON__[:68]
0000s0sbase::__inc::scope_guard::::DESTROYbase::__inc::scope_guard::DESTROY
0000s0sbase::__inc::::unhook base::__inc::unhook
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
1239µs118µs
# spent 18µs within JSON::MaybeXS::BEGIN@1 which was called: # once (18µs+0s) by JSON::MaybeXS::BEGIN@5 at line 1
use 5.008;
# spent 18µs making 1 call to JSON::MaybeXS::BEGIN@1
2package base;
3
421.52ms216µs
# spent 10µs (4+6) within base::BEGIN@4 which was called: # once (4µs+6µs) by JSON::MaybeXS::BEGIN@5 at line 4
use strict 'vars';
# spent 10µs making 1 call to base::BEGIN@4 # spent 6µs making 1 call to strict::import
510sour $VERSION = '2.27';
612µs$VERSION =~ tr/_//d;
7
8# simplest way to avoid indexing of the package: no package statement
9sub base::__inc::unhook { @INC = grep !(ref eq 'CODE' && $_ == $_[0]), @INC }
10# instance is blessed array of coderefs to be removed from @INC at scope exit
11sub base::__inc::scope_guard::DESTROY { base::__inc::unhook $_ for @{$_[0]} }
12
13# constant.pm is slow
14sub SUCCESS () { 1 }
15
16sub PUBLIC () { 2**0 }
17sub PRIVATE () { 2**1 }
18sub INHERITED () { 2**2 }
19sub PROTECTED () { 2**3 }
20
21
2211µsmy $Fattr = \%fields::attr;
23
24
# spent 57µs within base::has_fields which was called 13 times, avg 4µs/call: # 13 times (57µs+0s) by base::import at line 177, avg 4µs/call
sub has_fields {
251312µs my($base) = shift;
261314µs my $fglob = ${"$base\::"}{FIELDS};
271340µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
28}
29
30
# spent 30µs within base::has_attr which was called 13 times, avg 2µs/call: # 13 times (30µs+0s) by base::import at line 177, avg 2µs/call
sub has_attr {
31132µs my($proto) = shift;
32138µs my($class) = ref $proto || $proto;
331333µs return exists $Fattr->{$class};
34}
35
36sub get_attr {
37 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
38 return $Fattr->{$_[0]};
39}
40
4111µsif ($] < 5.009) {
42 *get_fields = sub {
43 # Shut up a possible typo warning.
44 () = \%{$_[0].'::FIELDS'};
45 my $f = \%{$_[0].'::FIELDS'};
46
47 # should be centralized in fields? perhaps
48 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
49 # is used here anyway, it doesn't matter.
50 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
51
52 return $f;
53 }
54}
55else {
56 *get_fields = sub {
57 # Shut up a possible typo warning.
58 () = \%{$_[0].'::FIELDS'};
59 return \%{$_[0].'::FIELDS'};
60 }
6116µs}
62
6311µsif ($] < 5.008) {
64 *_module_to_filename = sub {
65 (my $fn = $_[0]) =~ s!::!/!g;
66 $fn .= '.pm';
67 return $fn;
68 }
69}
70else {
71
# spent 182µs (114+68) within base::__ANON__[/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/base.pm:76] which was called 13 times, avg 14µs/call: # 13 times (114µs+68µs) by base::import at line 103, avg 14µs/call
*_module_to_filename = sub {
721386µs1346µs (my $fn = $_[0]) =~ s!::!/!g;
# spent 46µs making 13 calls to base::CORE:subst, avg 4µs/call
73137µs $fn .= '.pm';
741353µs1322µs utf8::encode($fn);
# spent 22µs making 13 calls to utf8::encode, avg 2µs/call
751337µs return $fn;
76 }
7711µs}
78
79
80
# spent 1.60ms (1.12+478µs) within base::import which was called 13 times, avg 123µs/call: # once (289µs+132µs) by YAML::PP::Preserve::Array::BEGIN@301 at line 301 of YAML/PP.pm # once (174µs+106µs) by YAML::PP::Preserve::Hash::BEGIN@227 at line 227 of YAML/PP.pm # once (163µs+25µs) by YAML::PP::Common::BEGIN@7 at line 7 of YAML/PP/Common.pm # once (78µs+32µs) by JSON::MaybeXS::BEGIN@5 at line 5 of JSON/MaybeXS.pm # once (64µs+26µs) by YAML::PP::Writer::File::BEGIN@9 at line 9 of YAML/PP/Writer/File.pm # once (59µs+27µs) by List::MoreUtils::XS::BEGIN@6 at line 6 of List/MoreUtils/XS.pm # once (55µs+28µs) by namespace::clean::_Util::BEGIN@15 at line 15 of namespace/clean/_Util.pm # once (50µs+19µs) by YAML::PP::Schema::JSON::BEGIN@7 at line 7 of YAML/PP/Schema/JSON.pm # once (39µs+21µs) by YAML::PP::BEGIN@15 at line 15 of YAML/PP.pm # once (42µs+16µs) by YAML::PP::Grammar::BEGIN@7 at line 7 of YAML/PP/Grammar.pm # once (39µs+16µs) by Variable::Magic::BEGIN@688 at line 688 of Variable/Magic.pm # once (38µs+15µs) by File::ShareDir::BEGIN@124 at line 124 of File/ShareDir.pm # once (30µs+15µs) by Class::Method::Modifiers::BEGIN@10 at line 10 of Class/Method/Modifiers.pm
sub import {
81139µs my $class = shift;
82
83137µs return SUCCESS unless @_;
84
85 # List of base classes from which we will inherit %FIELDS.
86133µs my $fields_base;
87
881311µs my $inheritor = caller(0);
89
90131µs my @bases;
911314µs foreach my $base (@_) {
921312µs if ( $inheritor eq $base ) {
93 warn "Class '$inheritor' tried to inherit from itself\n";
94 }
95
9613222µs1333µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 33µs making 13 calls to UNIVERSAL::isa, avg 3µs/call
97
98 # Following blocks help isolate $SIG{__DIE__} and @INC changes
99 {
1002610µs my $sigdie;
101 {
1022644µs local $SIG{__DIE__};
1031340µs13182µs my $fn = _module_to_filename($base);
# spent 182µs making 13 calls to base::__ANON__[base.pm:76], avg 14µs/call
104134µs my $dot_hidden;
105135µs eval {
106134µs my $guard;
107133µs if ($INC[-1] eq '.' && %{"$base\::"}) {
108 # So: the package already exists => this an optional load
109 # And: there is a dot at the end of @INC => we want to hide it
110 # However: we only want to hide it during our *own* require()
111 # (i.e. without affecting nested require()s).
112 # So we add a hook to @INC whose job is to hide the dot, but which
113 # first checks checks the callstack depth, because within nested
114 # require()s the callstack is deeper.
115 # Since CORE::GLOBAL::require makes it unknowable in advance what
116 # the exact relevant callstack depth will be, we have to record it
117 # inside a hook. So we put another hook just for that at the front
118 # of @INC, where it's guaranteed to run -- immediately.
119 # The dot-hiding hook does its job by sitting directly in front of
120 # the dot and removing itself from @INC when reached. This causes
121 # the dot to move up one index in @INC, causing the loop inside
122 # pp_require() to skip it.
123 # Loaded coded may disturb this precise arrangement, but that's OK
124 # because the hook is inert by that time. It is only active during
125 # the top-level require(), when @INC is in our control. The only
126 # possible gotcha is if other hooks already in @INC modify @INC in
127 # some way during that initial require().
128 # Note that this jiggery hookery works just fine recursively: if
129 # a module loaded via base.pm uses base.pm itself, there will be
130 # one pair of hooks in @INC per base::import call frame, but the
131 # pairs from different nestings do not interfere with each other.
132 my $lvl;
133 unshift @INC, sub { return if defined $lvl; 1 while defined caller ++$lvl; () };
134 splice @INC, -1, 0, sub { return if defined caller $lvl; ++$dot_hidden, &base::__inc::unhook; () };
135 $guard = bless [ @INC[0,-2] ], 'base::__inc::scope_guard';
136 }
13713320µs require $fn
138 };
139138µs if ($dot_hidden && (my @fn = grep -e && !( -d _ || -b _ ), $fn.'c', $fn)) {
140 require Carp;
141 Carp::croak(<<ERROR);
142Base class package "$base" is not empty but "$fn[0]" exists in the current directory.
143 To help avoid security issues, base.pm now refuses to load optional modules
144 from the current working directory when it is the last entry in \@INC.
145 If your software worked on previous versions of Perl, the best solution
146 is to use FindBin to detect the path properly and to add that path to
147 \@INC. As a last resort, you can re-enable looking in the current working
148 directory by adding "use lib '.'" to your code.
149ERROR
150 }
151 # Only ignore "Can't locate" errors from our eval require.
152 # Other fatal errors (syntax etc) must be reported.
153 #
154 # changing the check here is fragile - if the check
155 # here isn't catching every error you want, you should
156 # probably be using parent.pm, which doesn't try to
157 # guess whether require is needed or failed,
158 # see [perl #118561]
15913242µs17176µs die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 150µs making 2 calls to base::CORE:regcomp, avg 75µs/call # spent 26µs making 15 calls to base::CORE:match, avg 2µs/call
160 || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
1611328µs unless (%{"$base\::"}) {
162 require Carp;
163 local $" = " ";
164 Carp::croak(<<ERROR);
165Base class package "$base" is empty.
166 (Perhaps you need to 'use' the module which defines that package first,
167 or make that module available in \@INC (\@INC contains: @INC).
168ERROR
169 }
1701345µs $sigdie = $SIG{__DIE__} || undef;
171 }
172 # Make sure a global $SIG{__DIE__} makes it out of the localization.
173136µs $SIG{__DIE__} = $sigdie if defined $sigdie;
174 }
175137µs push @bases, $base;
176
1771347µs2687µs if ( has_fields($base) || has_attr($base) ) {
# spent 57µs making 13 calls to base::has_fields, avg 4µs/call # spent 30µs making 13 calls to base::has_attr, avg 2µs/call
178 # No multiple fields inheritance *suck*
179 if ($fields_base) {
180 require Carp;
181 Carp::croak("Can't multiply inherit fields");
182 } else {
183 $fields_base = $base;
184 }
185 }
186 }
187 # Save this until the end so it's all or nothing if the above loop croaks.
18813184µs push @{"$inheritor\::ISA"}, @bases;
189
1901361µs if( defined $fields_base ) {
191 inherit_fields($inheritor, $fields_base);
192 }
193}
194
195
196sub inherit_fields {
197 my($derived, $base) = @_;
198
199 return SUCCESS unless $base;
200
201 my $battr = get_attr($base);
202 my $dattr = get_attr($derived);
203 my $dfields = get_fields($derived);
204 my $bfields = get_fields($base);
205
206 $dattr->[0] = @$battr;
207
208 if( keys %$dfields ) {
209 warn <<"END";
210$derived is inheriting from $base but already has its own fields!
211This will cause problems. Be sure you use base BEFORE declaring fields.
212END
213
214 }
215
216 # Iterate through the base's fields adding all the non-private
217 # ones to the derived class. Hang on to the original attribute
218 # (Public, Private, etc...) and add Inherited.
219 # This is all too complicated to do efficiently with add_fields().
220 while (my($k,$v) = each %$bfields) {
221 my $fno;
222 if ($fno = $dfields->{$k} and $fno != $v) {
223 require Carp;
224 Carp::croak ("Inherited fields can't override existing fields");
225 }
226
227 if( $battr->[$v] & PRIVATE ) {
228 $dattr->[$v] = PRIVATE | INHERITED;
229 }
230 else {
231 $dattr->[$v] = INHERITED | $battr->[$v];
232 $dfields->{$k} = $v;
233 }
234 }
235
236 foreach my $idx (1..$#{$battr}) {
237 next if defined $dattr->[$idx];
238 $dattr->[$idx] = $battr->[$idx] & INHERITED;
239 }
240}
241
242
24318µs1;
244
245__END__
 
# spent 26µs within base::CORE:match which was called 15 times, avg 2µs/call: # 15 times (26µs+0s) by base::import at line 159, avg 2µs/call
sub base::CORE:match; # opcode
# spent 150µs within base::CORE:regcomp which was called 2 times, avg 75µs/call: # 2 times (150µs+0s) by base::import at line 159, avg 75µs/call
sub base::CORE:regcomp; # opcode
# spent 46µs within base::CORE:subst which was called 13 times, avg 4µs/call: # 13 times (46µs+0s) by base::__ANON__[/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/base.pm:76] at line 72, avg 4µs/call
sub base::CORE:subst; # opcode
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.