← 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:05 2015

Filename/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/overload.pm
StatementsExecuted 128 statements in 951µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111402µs464µsoverload::::BEGIN@85overload::BEGIN@85
511144µs146µsoverload::::OVERLOADoverload::OVERLOAD
55553µs198µsoverload::::importoverload::import
11112µs19µsoverload::::BEGIN@116overload::BEGIN@116
11111µs107µsoverload::::BEGIN@146overload::BEGIN@146
1111µs1µsoverload::::CORE:matchoverload::CORE:match (opcode)
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
31600nsour $VERSION = '1.18';
4
519µ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;
2414µsfor $category (keys %ops) {
251568µs $ops_seen{$_}++ for (split /\s+/, $ops{$category});
26}
27
28sub nil {}
29
30
# spent 146µs (144+1) within overload::OVERLOAD which was called 5 times, avg 29µs/call: # 5 times (144µs+1µs) by overload::import at line 59, avg 29µs/call
sub OVERLOAD {
3152µs $package = shift;
32512µs my %arg = @_;
3352µs my ($sub, $fb);
34525µs $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
35510µs $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
36512µs *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
37511µs for (keys %arg) {
381112µs if ($_ eq 'fallback') {
39 $fb = $arg{$_};
40 } else {
4185µs warnings::warnif("overload arg '$_' is invalid")
42 unless $ops_seen{$_};
4384µs $sub = $arg{$_};
44812µs11µs if (not ref $sub and $sub !~ /::/) {
# spent 1µs making 1 call to overload::CORE:match
4513µs $ {$package . "::(" . $_} = $sub;
461900ns $sub = \&nil;
47 }
48 #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
49820µs *{$package . "::(" . $_} = \&{ $sub };
50 }
51 }
52529µs ${$package . "::()"} = $fb; # Make it findable too (fallback only).
53}
54
55
# spent 198µs (53+146) within overload::import which was called 5 times, avg 40µs/call: # once (8µs+39µs) by Exception::Class::Base::BEGIN@35 at line 35 of Exception/Class/Base.pm # once (11µs+33µs) by Test::Deep::Cmp::BEGIN@7 at line 7 of Test/Deep/Cmp.pm # once (12µs+27µs) by Devel::StackTrace::BEGIN@16 at line 16 of Devel/StackTrace.pm # once (12µs+25µs) by Text::Balanced::ErrorMsg::BEGIN@1021 at line 1021 of Text/Balanced.pm # once (9µs+21µs) by Data::DPath::Path::BEGIN@1.9 at line 1 of (eval 37)[lib/Data/DPath/Path.pm:55]
sub import {
5659µs $package = (caller())[0];
57 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
5852µs shift;
59538µs5146µs $package->overload::OVERLOAD(@_);
# spent 146µs making 5 calls to overload::OVERLOAD, avg 29µ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};
852263µs2476µs
# spent 464µs (402+62) within overload::BEGIN@85 which was called: # once (402µs+62µs) by main::BEGIN@7 at line 85
no overloading;
# spent 464µs making 1 call to overload::BEGIN@85 # spent 12µ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 {
1162158µs227µs
# spent 19µs (12+8) within overload::BEGIN@116 which was called: # once (12µs+8µs) by main::BEGIN@7 at line 116
no overloading;
# spent 19µs making 1 call to overload::BEGIN@116 # spent 8µs making 1 call to overloading::unimport
117 "$_[0]";
118}
119
12012µ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
13812µ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
1462225µs2203µs
# spent 107µs (11+96) within overload::BEGIN@146 which was called: # once (11µs+96µs) by main::BEGIN@7 at line 146
use warnings::register;
# spent 107µs making 1 call to overload::BEGIN@146 # spent 96µ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
182112µs1;
183
184__END__
 
# spent 1µs within overload::CORE:match which was called: # once (1µs+0s) by overload::OVERLOAD at line 44
sub overload::CORE:match; # opcode