← Index
NYTProf Performance Profile   « line view »
For fastest.pl
  Run on Fri Jan 31 20:48:16 2014
Reported on Fri Jan 31 20:49:40 2014

Filename/opt/perl-5.18.1/lib/5.18.1/overload.pm
StatementsExecuted 280 statements in 1.38ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111492µs523µsoverload::::BEGIN@83overload::BEGIN@83
711257µs257µsoverload::::OVERLOADoverload::OVERLOAD
3922113µs113µsoverload::::AddrRefoverload::AddrRef
77688µs345µsoverload::::importoverload::import
11111µs19µsoverload::::BEGIN@114overload::BEGIN@114
1119µs95µsoverload::::BEGIN@144overload::BEGIN@144
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
31800nsour $VERSION = '1.22';
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
231200nsmy %ops_seen;
2418µsfor $category (keys %ops) {
251564µs $ops_seen{$_}++ for (split /\s+/, $ops{$category});
26}
27
28sub nil {}
29
30
# spent 257µs within overload::OVERLOAD which was called 7 times, avg 37µs/call: # 7 times (257µs+0s) by overload::import at line 59, avg 37µs/call
sub OVERLOAD {
3171µs $package = shift;
32719µs my %arg = @_;
3372µs my ($sub, $fb);
34731µs *{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
35757µs for (keys %arg) {
363221µs if ($_ eq 'fallback') {
37718µs for my $sym (*{$package . "::()"}) {
3876µs *$sym = \&nil; # Make it findable via fetchmethod.
39711µs $$sym = $arg{$_};
40 }
41 } else {
42259µs warnings::warnif("overload arg '$_' is invalid")
43 unless $ops_seen{$_};
44257µs $sub = $arg{$_};
45255µs if (not ref $sub) {
4625µs $ {$package . "::(" . $_} = $sub;
4722µs $sub = \&nil;
48 }
49 #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
502558µs *{$package . "::(" . $_} = \&{ $sub };
51 }
52 }
53}
54
55
# spent 345µs (88+257) within overload::import which was called 7 times, avg 49µs/call: # once (14µs+83µs) by Type::Tiny::BEGIN@31 at line 46 of Type/Tiny.pm # once (15µs+40µs) by Type::Coercion::BEGIN@19 at line 24 of Type/Coercion.pm # once (12µs+39µs) by Moose::Meta::TypeConstraint::BEGIN@14 at line 17 of Moose/Meta/TypeConstraint.pm # once (12µs+25µs) by Moose::Meta::Role::Method::Required::BEGIN@14 at line 15 of Moose/Meta/Role/Method/Required.pm # once (12µs+25µs) by Class::MOP::Method::BEGIN@21 at line 21 of Class/MOP/Method.pm # once (11µs+24µs) by Types::Standard::LazyLoad::BEGIN@53 at line 66 of Types/Standard.pm # once (12µs+21µs) by Types::Standard::_Stringable::BEGIN@45 at line 45 of Types/Standard.pm
sub import {
56716µs $package = (caller())[0];
57 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
5872µs shift;
59761µs7257µs $package->overload::OVERLOAD(@_);
# spent 257µs making 7 calls to overload::OVERLOAD, avg 37µs/call
60}
61
62sub unimport {
63 $package = (caller())[0];
64 shift;
65 *{$package . "::(("} = \&nil;
66 for (@_) {
67 warnings::warnif("overload arg '$_' is invalid")
68 unless $ops_seen{$_};
69 delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
70 }
71}
72
73sub Overloaded {
74 my $package = shift;
75 $package = ref $package if ref $package;
76 mycan ($package, '()') || mycan ($package, '((');
77}
78
79sub ov_method {
80 my $globref = shift;
81 return undef unless $globref;
82 my $sub = \&{*$globref};
832332µs2532µs
# spent 523µs (492+31) within overload::BEGIN@83 which was called: # once (492µs+31µs) by Data::OptList::BEGIN@10 at line 83
no overloading;
# spent 523µs making 1 call to overload::BEGIN@83 # spent 9µs making 1 call to overloading::unimport
84 return $sub if !ref $sub or $sub != \&nil;
85 return shift->can($ {*$globref});
86}
87
88sub OverloadedStringify {
89 my $package = shift;
90 $package = ref $package if ref $package;
91 #$package->can('(""')
92 ov_method mycan($package, '(""'), $package
93 or ov_method mycan($package, '(0+'), $package
94 or ov_method mycan($package, '(bool'), $package
95 or ov_method mycan($package, '(nomethod'), $package;
96}
97
98sub Method {
99 my $package = shift;
100 if(ref $package) {
101 local $@;
102 local $!;
103 require Scalar::Util;
104 $package = Scalar::Util::blessed($package);
105 return undef if !defined $package;
106 }
107 #my $meth = $package->can('(' . shift);
108 ov_method mycan($package, '(' . shift), $package;
109 #return $meth if $meth ne \&nil;
110 #return $ {*{$meth}};
111}
112
113
# spent 113µs within overload::AddrRef which was called 39 times, avg 3µs/call: # 37 times (109µs+0s) by Type::Tiny::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Type/Tiny.pm:31] at line 31 of Type/Tiny.pm, avg 3µs/call # 2 times (4µs+0s) by Method::Generate::Accessor::_validate_codulatable at line 615 of Method/Generate/Accessor.pm, avg 2µs/call
sub AddrRef {
1142194µs227µs
# spent 19µs (11+8) within overload::BEGIN@114 which was called: # once (11µs+8µs) by Data::OptList::BEGIN@10 at line 114
no overloading;
# spent 19µs making 1 call to overload::BEGIN@114 # spent 8µs making 1 call to overloading::unimport
11539140µs "$_[0]";
116}
117
11811µs*StrVal = *AddrRef;
119
120sub mycan { # Real can would leave stubs.
121 my ($package, $meth) = @_;
122
123 local $@;
124 local $!;
125 require mro;
126
127 my $mro = mro::get_linear_isa($package);
128 foreach my $p (@$mro) {
129 my $fqmeth = $p . q{::} . $meth;
130 return \*{$fqmeth} if defined &{$fqmeth};
131 }
132
133 return undef;
134}
135
13612µs%constants = (
137 'integer' => 0x1000, # HINT_NEW_INTEGER
138 'float' => 0x2000, # HINT_NEW_FLOAT
139 'binary' => 0x4000, # HINT_NEW_BINARY
140 'q' => 0x8000, # HINT_NEW_STRING
141 'qr' => 0x10000, # HINT_NEW_RE
142 );
143
1442284µs2181µs
# spent 95µs (9+86) within overload::BEGIN@144 which was called: # once (9µs+86µs) by Data::OptList::BEGIN@10 at line 144
use warnings::register;
# spent 95µs making 1 call to overload::BEGIN@144 # spent 86µs making 1 call to warnings::register::import
145sub constant {
146 # Arguments: what, sub
147 while (@_) {
148 if (@_ == 1) {
149 warnings::warnif ("Odd number of arguments for overload::constant");
150 last;
151 }
152 elsif (!exists $constants {$_ [0]}) {
153 warnings::warnif ("'$_[0]' is not an overloadable type");
154 }
155 elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) {
156 # Can't use C<ref $_[1] eq "CODE"> above as code references can be
157 # blessed, and C<ref> would return the package the ref is blessed into.
158 if (warnings::enabled) {
159 $_ [1] = "undef" unless defined $_ [1];
160 warnings::warn ("'$_[1]' is not a code reference");
161 }
162 }
163 else {
164 $^H{$_[0]} = $_[1];
165 $^H |= $constants{$_[0]};
166 }
167 shift, shift;
168 }
169}
170
171sub remove_constant {
172 # Arguments: what, sub
173 while (@_) {
174 delete $^H{$_[0]};
175 $^H &= ~ $constants{$_[0]};
176 shift, shift;
177 }
178}
179
180115µs1;
181
182__END__