Profile of overload.pm

Filename	/usr/lib/perl5/5.14/overload.pm
Statements	Executed 59 statements in 719µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	226µs	440µs	overload::::BEGIN@147overload::BEGIN@147
3	1	1	143µs	146µs	overload::::OVERLOADoverload::OVERLOAD
3	3	2	46µs	193µs	overload::::importoverload::import
2	1	1	4µs	4µs	overload::::CORE:matchoverload::CORE:match (opcode)
0	0	0	0s	0s	overload::::AddrRefoverload::AddrRef
0	0	0	0s	0s	overload::::Methodoverload::Method
0	0	0	0s	0s	overload::::Overloadedoverload::Overloaded
0	0	0	0s	0s	overload::::OverloadedStringifyoverload::OverloadedStringify
0	0	0	0s	0s	overload::::constantoverload::constant
0	0	0	0s	0s	overload::::mycanoverload::mycan
0	0	0	0s	0s	overload::::niloverload::nil
0	0	0	0s	0s	overload::::ov_methodoverload::ov_method
0	0	0	0s	0s	overload::::remove_constantoverload::remove_constant
0	0	0	0s	0s	overload::::unimportoverload::unimport

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package overload;
2
3	1	1µs			our $VERSION = '1.13';
4
5					sub nil {}
6
7					# spent 146µs (143+3) within overload::OVERLOAD which was called 3 times, avg 49µs/call: # 3 times (143µs+3µs) by overload::import at line 34, avg 49µs/call sub OVERLOAD {
8	3	2µs			$package = shift;
9	3	12µs			my %arg = @_;
10	3	3µs			my ($sub, $fb);
11	3	25µs			$ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
12	3	11µs			$fb = ${$package . "::()"}; # preserve old fallback value RT#68196
13	3	10µs			*{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
14	3	11µs			for (keys %arg) {
15	6	12µs			if ($_ eq 'fallback') {
16					$fb = $arg{$_};
17					} else {
18	3	4µs			$sub = $arg{$_};
19	3	20µs	2	4µs	if (not ref $sub and $sub !~ /::/) { # spent 4µs making 2 calls to overload::CORE:match, avg 2µs/call
20	2	8µs			$ {$package . "::(" . $_} = $sub;
21	2	3µs			$sub = \&nil;
22					}
23					#print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
24	3	10µs			*{$package . "::(" . $_} = \&{ $sub };
25					}
26					}
27	3	25µs			${$package . "::()"} = $fb; # Make it findable too (fallback only).
28					}
29
30					# spent 193µs (46+146) within overload::import which was called 3 times, avg 64µs/call: # once (15µs+60µs) by File::Temp::BEGIN@163 at line 163 of File/Temp.pm # once (14µs+45µs) by File::Temp::Dir::BEGIN@2407 at line 2407 of File/Temp.pm # once (17µs+42µs) by File::stat::BEGIN@147 at line 168 of File/stat.pm sub import {
31	3	11µs			$package = (caller())[0];
32					# *{$package . "::OVERLOAD"} = \&OVERLOAD;
33	3	2µs			shift;
34	3	32µs	3	146µs	$package->overload::OVERLOAD(@_); # spent 146µs making 3 calls to overload::OVERLOAD, avg 49µs/call
35					}
36
37					sub unimport {
38					$package = (caller())[0];
39					${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
40					shift;
41					for (@_) {
42					if ($_ eq 'fallback') {
43					undef $ {$package . "::()"};
44					} else {
45					delete $ {$package . "::"}{"(" . $_};
46					}
47					}
48					}
49
50					sub Overloaded {
51					my $package = shift;
52					$package = ref $package if ref $package;
53					$package->can('()');
54					}
55
56					sub ov_method {
57					my $globref = shift;
58					return undef unless $globref;
59					my $sub = \&{*$globref};
60					require Scalar::Util;
61					return $sub
62					if Scalar::Util::refaddr($sub) != Scalar::Util::refaddr(\&nil);
63					return shift->can($ {*$globref});
64					}
65
66					sub OverloadedStringify {
67					my $package = shift;
68					$package = ref $package if ref $package;
69					#$package->can('(""')
70					ov_method mycan($package, '(""'), $package
71					or ov_method mycan($package, '(0+'), $package
72					or ov_method mycan($package, '(bool'), $package
73					or ov_method mycan($package, '(nomethod'), $package;
74					}
75
76					sub Method {
77					my $package = shift;
78					if(ref $package) {
79					local $@;
80					local $!;
81					require Scalar::Util;
82					$package = Scalar::Util::blessed($package);
83					return undef if !defined $package;
84					}
85					#my $meth = $package->can('(' . shift);
86					ov_method mycan($package, '(' . shift), $package;
87					#return $meth if $meth ne \&nil;
88					#return $ {*{$meth}};
89					}
90
91					sub AddrRef {
92					my $package = ref $_[0];
93					return "$_[0]" unless $package;
94
95					local $@;
96					local $!;
97					require Scalar::Util;
98					my $class = Scalar::Util::blessed($_[0]);
99					my $class_prefix = defined($class) ? "$class=" : "";
100					my $type = Scalar::Util::reftype($_[0]);
101					my $addr = Scalar::Util::refaddr($_[0]);
102					return sprintf("%s%s(0x%x)", $class_prefix, $type, $addr);
103					}
104
105	1	4µs			StrVal = AddrRef;
106
107					sub mycan { # Real can would leave stubs.
108					my ($package, $meth) = @_;
109
110					local $@;
111					local $!;
112					require mro;
113
114					my $mro = mro::get_linear_isa($package);
115					foreach my $p (@$mro) {
116					my $fqmeth = $p . q{::} . $meth;
117					return \*{$fqmeth} if defined &{$fqmeth};
118					}
119
120					return undef;
121					}
122
123	1	5µs			%constants = (
124					'integer' => 0x1000, # HINT_NEW_INTEGER
125					'float' => 0x2000, # HINT_NEW_FLOAT
126					'binary' => 0x4000, # HINT_NEW_BINARY
127					'q' => 0x8000, # HINT_NEW_STRING
128					'qr' => 0x10000, # HINT_NEW_RE
129					);
130
131	1	17µs			%ops = ( with_assign => "+ - * / % ** << >> x .",
132					assign => "+= -= = /= %= *= <<= >>= x= .=",
133					num_comparison => "< <= > >= == !=",
134					'3way_comparison'=> "<=> cmp",
135					str_comparison => "lt le gt ge eq ne",
136					binary => '& &= \| \|= ^ ^=',
137					unary => "neg ! ~",
138					mutators => '++ --',
139					func => "atan2 cos sin exp abs log sqrt int",
140					conversion => 'bool "" 0+ qr',
141					iterators => '<>',
142					filetest => "-X",
143					dereferencing => '${} @{} %{} &{} *{}',
144					matching => '~~',
145					special => 'nomethod fallback =');
146
147	2	452µs	2	654µs	# spent 440µs (226+214) within overload::BEGIN@147 which was called: # once (226µs+214µs) by installer::BEGIN@33 at line 147 use warnings::register; # spent 440µs making 1 call to overload::BEGIN@147 # spent 214µs making 1 call to warnings::register::import
148					sub constant {
149					# Arguments: what, sub
150					while (@_) {
151					if (@_ == 1) {
152					warnings::warnif ("Odd number of arguments for overload::constant");
153					last;
154					}
155					elsif (!exists $constants {$_ [0]}) {
156					warnings::warnif ("`$_[0]' is not an overloadable type");
157					}
158					elsif (!ref $_ [1] \|\| "$_[1]" !~ /(^\|=)CODE$0x[0-9a-f]+$$/) {
159					# Can't use C<ref $_[1] eq "CODE"> above as code references can be
160					# blessed, and C<ref> would return the package the ref is blessed into.
161					if (warnings::enabled) {
162					$_ [1] = "undef" unless defined $_ [1];
163					warnings::warn ("`$_[1]' is not a code reference");
164					}
165					}
166					else {
167					$^H{$_[0]} = $_[1];
168					$^H \|= $constants{$_[0]};
169					}
170					shift, shift;
171					}
172					}
173
174					sub remove_constant {
175					# Arguments: what, sub
176					while (@_) {
177					delete $^H{$_[0]};
178					$^H &= ~ $constants{$_[0]};
179					shift, shift;
180					}
181					}
182
183	1	42µs			1;
184
185					__END__

					# spent 4µs within overload::CORE:match which was called 2 times, avg 2µs/call: # 2 times (4µs+0s) by overload::OVERLOAD at line 19, avg 2µs/call sub overload::CORE:match; # opcode