← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 18:42:36 2015
Reported on Fri Jul 31 18:48:13 2015

Filename/usr/share/perl5/overload.pm
StatementsExecuted 249 statements in 1.60ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111620µs668µsoverload::::BEGIN@85overload::BEGIN@85
911281µs281µsoverload::::OVERLOADoverload::OVERLOAD
998111µs392µsoverload::::importoverload::import
11117µs33µsoverload::::BEGIN@116overload::BEGIN@116
11115µs144µsoverload::::BEGIN@146overload::BEGIN@146
0000s0soverload::::AddrRefoverload::AddrRef
0000s0soverload::::Methodoverload::Method
0000s0soverload::::Overloadedoverload::Overloaded
0000s0soverload::::OverloadedStringifyoverload::OverloadedStringify
0000s0soverload::::constantoverload::constant
0000s0soverload::::mycanoverload::mycan
0000s0soverload::::niloverload::nil
0000s0soverload::::ov_methodoverload::ov_method
0000s0soverload::::remove_constantoverload::remove_constant
0000s0soverload::::unimportoverload::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package overload;
2
311µsour $VERSION = '1.18';
4
5111µs%ops = (
6 with_assign => "+ - * / % ** << >> x .",
7 assign => "+= -= *= /= %= **= <<= >>= x= .=",
8 num_comparison => "< <= > >= == !=",
9 '3way_comparison' => "<=> cmp",
10 str_comparison => "lt le gt ge eq ne",
11 binary => '& &= | |= ^ ^=',
12 unary => "neg ! ~",
13 mutators => '++ --',
14 func => "atan2 cos sin exp abs log sqrt int",
15 conversion => 'bool "" 0+ qr',
16 iterators => '<>',
17 filetest => "-X",
18 dereferencing => '${} @{} %{} &{} *{}',
19 matching => '~~',
20 special => 'nomethod fallback =',
21);
22
231400nsmy %ops_seen;
2416µsfor $category (keys %ops) {
251591µs $ops_seen{$_}++ for (split /\s+/, $ops{$category});
26}
27
28sub nil {}
29
30
# spent 281µs within overload::OVERLOAD which was called 9 times, avg 31µs/call: # 9 times (281µs+0s) by overload::import at line 59, avg 31µs/call
sub OVERLOAD {
3193µs $package = shift;
32923µs my %arg = @_;
3392µs my ($sub, $fb);
34943µs $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
35917µs $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
36920µs *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
37922µs for (keys %arg) {
382827µs if ($_ eq 'fallback') {
39 $fb = $arg{$_};
40 } else {
412110µs warnings::warnif("overload arg '$_' is invalid")
42 unless $ops_seen{$_};
43218µs $sub = $arg{$_};
442112µs if (not ref $sub and $sub !~ /::/) {
45516µs $ {$package . "::(" . $_} = $sub;
4654µs $sub = \&nil;
47 }
48 #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
492142µs *{$package . "::(" . $_} = \&{ $sub };
50 }
51 }
52959µs ${$package . "::()"} = $fb; # Make it findable too (fallback only).
53}
54
55
# spent 392µs (111+281) within overload::import which was called 9 times, avg 44µs/call: # once (18µs+55µs) by Error::BEGIN@20 at line 24 of Error.pm # once (15µs+32µs) by Fh::BEGIN@3833 at line 3833 of CGI.pm # once (11µs+31µs) by URI::BEGIN@24 at line 27 of URI.pm # once (11µs+31µs) by File::Temp::BEGIN@32 at line 32 of File/Temp.pm # once (13µs+28µs) by JSON::XS::Boolean::BEGIN@3 at line 14 of (eval 10)[JSON.pm:353] # once (12µs+28µs) by JSON::PP::Boolean::BEGIN@1407 at line 1411 of JSON/PP.pm # once (12µs+27µs) by CGI::Cookie::BEGIN@22 at line 22 of CGI/Cookie.pm # once (11µs+25µs) by JSON::PP::Boolean::BEGIN@3 at line 14 of (eval 11)[JSON.pm:353] # once (9µs+24µs) by File::Temp::Dir::BEGIN@1575 at line 1575 of File/Temp.pm
sub import {
56930µs $package = (caller())[0];
57 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
5893µs shift;
59972µs9281µs $package->overload::OVERLOAD(@_);
# spent 281µs making 9 calls to overload::OVERLOAD, avg 31µs/call
60}
61
62sub unimport {
63 $package = (caller())[0];
64 ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
65 shift;
66 for (@_) {
67 if ($_ eq 'fallback') {
68 undef $ {$package . "::()"};
69 } else {
70 delete $ {$package . "::"}{"(" . $_};
71 }
72 }
73}
74
75sub Overloaded {
76 my $package = shift;
77 $package = ref $package if ref $package;
78 mycan ($package, '()');
79}
80
81sub ov_method {
82 my $globref = shift;
83 return undef unless $globref;
84 my $sub = \&{*$globref};
852438µs2684µs
# spent 668µs (620+48) within overload::BEGIN@85 which was called: # once (620µs+48µs) by Error::BEGIN@20 at line 85
no overloading;
# spent 668µs making 1 call to overload::BEGIN@85 # spent 16µs making 1 call to overloading::unimport
86 return $sub if !ref $sub or $sub != \&nil;
87 return shift->can($ {*$globref});
88}
89
90sub OverloadedStringify {
91 my $package = shift;
92 $package = ref $package if ref $package;
93 #$package->can('(""')
94 ov_method mycan($package, '(""'), $package
95 or ov_method mycan($package, '(0+'), $package
96 or ov_method mycan($package, '(bool'), $package
97 or ov_method mycan($package, '(nomethod'), $package;
98}
99
100sub Method {
101 my $package = shift;
102 if(ref $package) {
103 local $@;
104 local $!;
105 require Scalar::Util;
106 $package = Scalar::Util::blessed($package);
107 return undef if !defined $package;
108 }
109 #my $meth = $package->can('(' . shift);
110 ov_method mycan($package, '(' . shift), $package;
111 #return $meth if $meth ne \&nil;
112 #return $ {*{$meth}};
113}
114
115sub AddrRef {
1162241µs249µs
# spent 33µs (17+16) within overload::BEGIN@116 which was called: # once (17µs+16µs) by Error::BEGIN@20 at line 116
no overloading;
# spent 33µs making 1 call to overload::BEGIN@116 # spent 16µs making 1 call to overloading::unimport
117 "$_[0]";
118}
119
12013µs*StrVal = *AddrRef;
121
122sub mycan { # Real can would leave stubs.
123 my ($package, $meth) = @_;
124
125 local $@;
126 local $!;
127 require mro;
128
129 my $mro = mro::get_linear_isa($package);
130 foreach my $p (@$mro) {
131 my $fqmeth = $p . q{::} . $meth;
132 return \*{$fqmeth} if defined &{$fqmeth};
133 }
134
135 return undef;
136}
137
13813µs%constants = (
139 'integer' => 0x1000, # HINT_NEW_INTEGER
140 'float' => 0x2000, # HINT_NEW_FLOAT
141 'binary' => 0x4000, # HINT_NEW_BINARY
142 'q' => 0x8000, # HINT_NEW_STRING
143 'qr' => 0x10000, # HINT_NEW_RE
144 );
145
1462372µs2272µs
# spent 144µs (15+129) within overload::BEGIN@146 which was called: # once (15µs+129µs) by Error::BEGIN@20 at line 146
use warnings::register;
# spent 144µs making 1 call to overload::BEGIN@146 # spent 129µs making 1 call to warnings::register::import
147sub constant {
148 # Arguments: what, sub
149 while (@_) {
150 if (@_ == 1) {
151 warnings::warnif ("Odd number of arguments for overload::constant");
152 last;
153 }
154 elsif (!exists $constants {$_ [0]}) {
155 warnings::warnif ("'$_[0]' is not an overloadable type");
156 }
157 elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) {
158 # Can't use C<ref $_[1] eq "CODE"> above as code references can be
159 # blessed, and C<ref> would return the package the ref is blessed into.
160 if (warnings::enabled) {
161 $_ [1] = "undef" unless defined $_ [1];
162 warnings::warn ("'$_[1]' is not a code reference");
163 }
164 }
165 else {
166 $^H{$_[0]} = $_[1];
167 $^H |= $constants{$_[0]};
168 }
169 shift, shift;
170 }
171}
172
173sub remove_constant {
174 # Arguments: what, sub
175 while (@_) {
176 delete $^H{$_[0]};
177 $^H &= ~ $constants{$_[0]};
178 shift, shift;
179 }
180}
181
182117µs1;
183
184__END__