← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:09 2015

Filename/usr/share/perl5/overload.pm
StatementsExecuted 208 statements in 1.61ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111602µs657µsoverload::::BEGIN@85overload::BEGIN@85
511187µs187µsoverload::::OVERLOADoverload::OVERLOAD
55480µs268µsoverload::::importoverload::import
551170µs70µsoverload::::AddrRefoverload::AddrRef
11117µs29µsoverload::::BEGIN@116overload::BEGIN@116
11116µs139µsoverload::::BEGIN@146overload::BEGIN@146
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
31900nsour $VERSION = '1.18';
4
5110µ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
231300nsmy %ops_seen;
2416µsfor $category (keys %ops) {
2515100µs $ops_seen{$_}++ for (split /\s+/, $ops{$category});
26}
27
28sub nil {}
29
30
# spent 187µs within overload::OVERLOAD which was called 5 times, avg 37µs/call: # 5 times (187µs+0s) by overload::import at line 59, avg 37µs/call
sub OVERLOAD {
3152µs $package = shift;
32515µs my %arg = @_;
3352µs my ($sub, $fb);
34527µs $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
35514µs $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
36512µs *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
37512µs for (keys %arg) {
381617µs if ($_ eq 'fallback') {
39 $fb = $arg{$_};
40 } else {
41115µs warnings::warnif("overload arg '$_' is invalid")
42 unless $ops_seen{$_};
43115µs $sub = $arg{$_};
441112µs if (not ref $sub and $sub !~ /::/) {
45511µs $ {$package . "::(" . $_} = $sub;
4654µs $sub = \&nil;
47 }
48 #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
491133µs *{$package . "::(" . $_} = \&{ $sub };
50 }
51 }
52547µs ${$package . "::()"} = $fb; # Make it findable too (fallback only).
53}
54
55
# spent 268µs (80+187) within overload::import which was called 5 times, avg 54µs/call: # once (26µs+43µs) by Fh::BEGIN@3833 at line 3833 of CGI.pm # once (17µs+48µs) by Error::BEGIN@20 at line 24 of Error.pm # once (16µs+34µs) by CGI::Cookie::BEGIN@22 at line 22 of CGI/Cookie.pm # once (11µs+31µs) by File::Temp::BEGIN@32 at line 32 of File/Temp.pm # once (10µs+31µs) by File::Temp::Dir::BEGIN@1575 at line 1575 of File/Temp.pm
sub import {
56518µs $package = (caller())[0];
57 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
5852µs shift;
59538µs5187µs $package->overload::OVERLOAD(@_);
# spent 187µs making 5 calls to overload::OVERLOAD, avg 37µ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};
852453µs2672µs
# spent 657µs (602+55) within overload::BEGIN@85 which was called: # once (602µs+55µs) by Error::BEGIN@20 at line 85
no overloading;
# spent 657µ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
115
# spent 70µs within overload::AddrRef which was called 55 times, avg 1µs/call: # 55 times (70µs+0s) by Carp::format_arg at line 183 of Carp.pm, avg 1µs/call
sub AddrRef {
1162257µs242µs
# spent 29µs (17+13) within overload::BEGIN@116 which was called: # once (17µs+13µs) by Error::BEGIN@20 at line 116
no overloading;
# spent 29µs making 1 call to overload::BEGIN@116 # spent 12µs making 1 call to overloading::unimport
11755115µs "$_[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
1462365µs2262µs
# spent 139µs (16+123) within overload::BEGIN@146 which was called: # once (16µs+123µs) by Error::BEGIN@20 at line 146
use warnings::register;
# spent 139µs making 1 call to overload::BEGIN@146 # spent 123µ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__