Profile of overload.pm

Filename	/usr/lib64/perl5/5.16.0/overload.pm
Statements	Executed 346 statements in 8.00ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
15	1	1	2.45ms	2.47ms	overload::::OVERLOADoverload::OVERLOAD
1	1	1	2.25ms	2.44ms	overload::::BEGIN@85overload::BEGIN@85
15	15	13	848µs	3.32ms	overload::::importoverload::import
1	1	1	68µs	716µs	overload::::BEGIN@146overload::BEGIN@146
1	1	1	64µs	112µs	overload::::BEGIN@116overload::BEGIN@116
3	1	1	22µs	22µ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	4µs			our $VERSION = '1.18';
4
5	1	37µ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
23	1	1µs			my %ops_seen;
24	1	20µs			for $category (keys %ops) {
25	15	449µs			$ops_seen{$_}++ for (split /\s+/, $ops{$category});
26					}
27
28					sub nil {}
29
30					# spent 2.47ms (2.45+22µs) within overload::OVERLOAD which was called 15 times, avg 165µs/call: # 15 times (2.45ms+22µs) by overload::import at line 59, avg 165µs/call sub OVERLOAD {
31	15	23µs			$package = shift;
32	15	205µs			my %arg = @_;
33	15	32µs			my ($sub, $fb);
34	15	360µs			$ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
35	15	169µs			$fb = ${$package . "::()"}; # preserve old fallback value RT#68196
36	15	174µs			*{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
37	15	206µs			for (keys %arg) {
38	35	219µs			if ($_ eq 'fallback') {
39					$fb = $arg{$_};
40					} else {
41	28	66µs			warnings::warnif("overload arg '$_' is invalid")
42					unless $ops_seen{$_};
43	28	53µs			$sub = $arg{$_};
44	28	188µs	3	22µs	if (not ref $sub and $sub !~ /::/) { # spent 22µs making 3 calls to overload::CORE:match, avg 7µs/call
45	3	49µs			$ {$package . "::(" . $_} = $sub;
46	3	15µs			$sub = \&nil;
47					}
48					#print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
49	28	430µs			*{$package . "::(" . $_} = \&{ $sub };
50					}
51					}
52	15	490µs			${$package . "::()"} = $fb; # Make it findable too (fallback only).
53					}
54
55					# spent 3.32ms (848µs+2.47) within overload::import which was called 15 times, avg 221µs/call: # once (53µs+255µs) by File::Temp::BEGIN@163 at line 163 of File/Temp.pm # once (98µs+168µs) by XML::LibXML::NodeList::BEGIN@23 at line 29 of XML/LibXML/NodeList.pm # once (66µs+196µs) by XML::LibXML::Boolean::BEGIN@21 at line 21 of XML/LibXML/Boolean.pm # once (67µs+172µs) by Getopt::Long::CallBack::BEGIN@1489 at line 1489 of Getopt/Long.pm # once (73µs+160µs) by JSON::XS::Boolean::BEGIN@3 at line 14 of (eval 15)[JSON.pm:353] # once (50µs+180µs) by Pod::Simple::LinkSection::BEGIN@13 at line 14 of Pod/Simple/LinkSection.pm # once (60µs+162µs) by JSON::XS::Boolean::BEGIN@1496 at line 1499 of JSON/XS.pm # once (50µs+171µs) by XML::LibXML::Error::BEGIN@22 at line 29 of XML/LibXML/Error.pm # once (51µs+170µs) by XML::LibXML::Number::BEGIN@19 at line 19 of XML/LibXML/Number.pm # once (46µs+170µs) by XML::SAX::Exception::BEGIN@8 at line 8 of XML/SAX/Exception.pm # once (45µs+168µs) by File::Temp::Dir::BEGIN@2407 at line 2407 of File/Temp.pm # once (49µs+154µs) by XML::LibXML::Literal::BEGIN@19 at line 19 of XML/LibXML/Literal.pm # once (47µs+140µs) by JSON::PP::Boolean::BEGIN@3 at line 14 of (eval 16)[JSON.pm:353] # once (52µs+122µs) by IO::Scalar::BEGIN@157 at line 157 of IO/Scalar.pm # once (41µs+85µs) by IO::Scalar::BEGIN@158 at line 158 of IO/Scalar.pm sub import {
56	15	156µs			$package = (caller())[0];
57					# *{$package . "::OVERLOAD"} = \&OVERLOAD;
58	15	18µs			shift;
59	15	630µs	15	2.47ms	$package->overload::OVERLOAD(@_); # spent 2.47ms making 15 calls to overload::OVERLOAD, avg 165µs/call
60					}
61
62					sub 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
75					sub Overloaded {
76					my $package = shift;
77					$package = ref $package if ref $package;
78					mycan ($package, '()');
79					}
80
81					sub ov_method {
82					my $globref = shift;
83					return undef unless $globref;
84					my $sub = \&{*$globref};
85	2	1.73ms	2	2.49ms	# spent 2.44ms (2.25+183µs) within overload::BEGIN@85 which was called: # once (2.25ms+183µs) by JSON::XS::Boolean::BEGIN@3 at line 85 no overloading; # spent 2.44ms making 1 call to overload::BEGIN@85 # spent 56µs making 1 call to overloading::unimport
86					return $sub if !ref $sub or $sub != \&nil;
87					return shift->can($ {*$globref});
88					}
89
90					sub 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
100					sub 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					sub AddrRef {
116	2	897µs	2	161µs	# spent 112µs (64+49) within overload::BEGIN@116 which was called: # once (64µs+49µs) by JSON::XS::Boolean::BEGIN@3 at line 116 no overloading; # spent 112µs making 1 call to overload::BEGIN@116 # spent 49µs making 1 call to overloading::unimport
117					"$_[0]";
118					}
119
120	1	7µs			StrVal = AddrRef;
121
122					sub 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
138	1	11µ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
146	2	1.31ms	2	1.36ms	# spent 716µs (68+648) within overload::BEGIN@146 which was called: # once (68µs+648µs) by JSON::XS::Boolean::BEGIN@3 at line 146 use warnings::register; # spent 716µs making 1 call to overload::BEGIN@146 # spent 648µs making 1 call to warnings::register::import
147					sub 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
173					sub remove_constant {
174					# Arguments: what, sub
175					while (@_) {
176					delete $^H{$_[0]};
177					$^H &= ~ $constants{$_[0]};
178					shift, shift;
179					}
180					}
181
182	1	44µs			1;
183
184					__END__

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