Profile of overload.pm

Filename	/usr/lib/x86_64-linux-gnu/perl-base/overload.pm
Statements	Executed 214 statements in 914µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
7	1	1	110µs	110µs	overload::::OVERLOADoverload::OVERLOAD
7	7	5	40µs	150µs	overload::::importoverload::import
1	1	1	7µs	8µs	overload::::BEGIN@3overload::BEGIN@3
1	1	1	7µs	12µs	overload::::BEGIN@85overload::BEGIN@85
1	1	1	6µs	24µs	overload::::BEGIN@145overload::BEGIN@145
1	1	1	4µs	8µs	overload::::BEGIN@115overload::BEGIN@115
1	1	1	3µs	15µs	overload::::BEGIN@5overload::BEGIN@5
1	1	1	3µs	6µs	overload::::BEGIN@4overload::BEGIN@4
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	2	16µs	2	9µs	# spent 8µs (7+1) within overload::BEGIN@3 which was called: # once (7µs+1µs) by File::Temp::BEGIN@168 at line 3 use strict; # spent 8µs making 1 call to overload::BEGIN@3 # spent 1µs making 1 call to strict::import
4	2	15µs	2	8µs	# spent 6µs (3+3) within overload::BEGIN@4 which was called: # once (3µs+3µs) by File::Temp::BEGIN@168 at line 4 no strict 'refs'; # spent 6µs making 1 call to overload::BEGIN@4 # spent 3µs making 1 call to strict::unimport
5	2	286µs	2	27µs	# spent 15µs (3+12) within overload::BEGIN@5 which was called: # once (3µs+12µs) by File::Temp::BEGIN@168 at line 5 no warnings 'experimental::builtin'; # spent 15µs making 1 call to overload::BEGIN@5 # spent 12µs making 1 call to warnings::unimport
6
7	1	200ns			our $VERSION = '1.35';
8
9	1	5µs			our %ops = (
10					with_assign => "+ - * / % ** << >> x .",
11					assign => "+= -= = /= %= *= <<= >>= x= .=",
12					num_comparison => "< <= > >= == !=",
13					'3way_comparison' => "<=> cmp",
14					str_comparison => "lt le gt ge eq ne",
15					binary => '& &= \| \|= ^ ^= &. &.= \|. \|.= ^. ^.=',
16					unary => "neg ! ~ ~.",
17					mutators => '++ --',
18					func => "atan2 cos sin exp abs log sqrt int",
19					conversion => 'bool "" 0+ qr',
20					iterators => '<>',
21					filetest => "-X",
22					dereferencing => '${} @{} %{} &{} *{}',
23					matching => '~~',
24					special => 'nomethod fallback =',
25					);
26
27	1	200ns			my %ops_seen;
28	1	27µs			@ops_seen{ map split(/ /), values %ops } = ();
29
30					sub nil {}
31
32					# spent 110µs within overload::OVERLOAD which was called 7 times, avg 16µs/call: # 7 times (110µs+0s) by overload::import at line 61, avg 16µs/call sub OVERLOAD {
33	7	1µs			my $package = shift;
34	7	8µs			my %arg = @_;
35	7	1µs			my $sub;
36	7	23µs			*{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
37	7	28µs			for (keys %arg) {
38	28	8µs			if ($_ eq 'fallback') {
39	7	9µs			for my $sym (*{$package . "::()"}) {
40	7	2µs			*$sym = \&nil; # Make it findable via fetchmethod.
41	7	5µs			$$sym = $arg{$_};
42					}
43					} else {
44					warnings::warnif("overload arg '$_' is invalid")
45	21	7µs			unless exists $ops_seen{$_};
46	21	4µs			$sub = $arg{$_};
47	21	2µs			if (not ref $sub) {
48	3	3µs			$ {$package . "::(" . $_} = $sub;
49	3	700ns			$sub = \&nil;
50					}
51					#print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
52	21	18µs			*{$package . "::(" . $_} = \&{ $sub };
53					}
54					}
55					}
56
57					# spent 150µs (40+110) within overload::import which was called 7 times, avg 21µs/call: # once (6µs+25µs) by Contextual::Return::Value::BEGIN@1526 at line 1526 of Contextual/Return.pm # once (6µs+18µs) by Types::Serialiser::BooleanBase::BEGIN@126 at line 129 of Types/Serialiser.pm # once (9µs+13µs) by Getopt::Long::CallBack::BEGIN@1573 at line 1573 of Getopt/Long.pm # once (5µs+15µs) by File::Temp::Dir::BEGIN@2592 at line 2592 of File/Temp.pm # once (5µs+14µs) by Pod::Simple::LinkSection::BEGIN@11 at line 12 of Pod/Simple/LinkSection.pm # once (5µs+13µs) by File::Temp::BEGIN@168 at line 168 of File/Temp.pm # once (4µs+11µs) by Types::Serialiser::Error::BEGIN@157 at line 157 of Types/Serialiser.pm sub import {
58	7	9µs			my $package = (caller())[0];
59					# *{$package . "::OVERLOAD"} = \&OVERLOAD;
60	7	1µs			shift;
61	7	23µs	7	110µs	$package->overload::OVERLOAD(@_); # spent 110µs making 7 calls to overload::OVERLOAD, avg 16µs/call
62					}
63
64					sub unimport {
65					my $package = (caller())[0];
66					shift;
67					*{$package . "::(("} = \&nil;
68					for (@_) {
69					warnings::warnif("overload arg '$_' is invalid")
70					unless exists $ops_seen{$_};
71					delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
72					}
73					}
74
75					sub Overloaded {
76					my $package = shift;
77					$package = ref $package if ref $package;
78					mycan ($package, '()') \|\| mycan ($package, '((');
79					}
80
81					sub ov_method {
82					my $globref = shift;
83					return undef unless $globref;
84					my $sub = \&{*$globref};
85	2	116µs	2	17µs	# spent 12µs (7+5) within overload::BEGIN@85 which was called: # once (7µs+5µs) by File::Temp::BEGIN@168 at line 85 no overloading; # spent 12µs making 1 call to overload::BEGIN@85 # spent 5µs making 1 call to overloading::unimport
86					return $sub if $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					$package = builtin::blessed($package);
106					return undef if !defined $package;
107					}
108					#my $meth = $package->can('(' . shift);
109					ov_method mycan($package, '(' . shift), $package;
110					#return $meth if $meth ne \&nil;
111					#return $ {*{$meth}};
112					}
113
114					sub AddrRef {
115	2	112µs	2	12µs	# spent 8µs (4+4) within overload::BEGIN@115 which was called: # once (4µs+4µs) by File::Temp::BEGIN@168 at line 115 no overloading; # spent 8µs making 1 call to overload::BEGIN@115 # spent 4µs making 1 call to overloading::unimport
116					"$_[0]";
117					}
118
119	1	900ns			StrVal = AddrRef;
120
121					sub mycan { # Real can would leave stubs.
122					my ($package, $meth) = @_;
123
124					local $@;
125					local $!;
126					require mro;
127
128					my $mro = mro::get_linear_isa($package);
129					foreach my $p (@$mro) {
130					my $fqmeth = $p . q{::} . $meth;
131					return \*{$fqmeth} if defined &{$fqmeth};
132					}
133
134					return undef;
135					}
136
137	1	1µs			my %constants = (
138					'integer' => 0x1000, # HINT_NEW_INTEGER
139					'float' => 0x2000, # HINT_NEW_FLOAT
140					'binary' => 0x4000, # HINT_NEW_BINARY
141					'q' => 0x8000, # HINT_NEW_STRING
142					'qr' => 0x10000, # HINT_NEW_RE
143					);
144
145	2	171µs	2	42µs	# spent 24µs (6+18) within overload::BEGIN@145 which was called: # once (6µs+18µs) by File::Temp::BEGIN@168 at line 145 use warnings::register; # spent 24µs making 1 call to overload::BEGIN@145 # spent 18µs making 1 call to warnings::register::import
146					sub constant {
147					# Arguments: what, sub
148					while (@_) {
149					if (@_ == 1) {
150					warnings::warnif ("Odd number of arguments for overload::constant");
151					last;
152					}
153					elsif (!exists $constants {$_ [0]}) {
154					warnings::warnif ("'$_[0]' is not an overloadable type");
155					}
156					elsif (!ref $_ [1] \|\| "$_[1]" !~ /(^\|=)CODE$0x[0-9a-f]+$$/) {
157					# Can't use C<ref $_[1] eq "CODE"> above as code references can be
158					# blessed, and C<ref> would return the package the ref is blessed into.
159					if (warnings::enabled) {
160					$_ [1] = "undef" unless defined $_ [1];
161					warnings::warn ("'$_[1]' is not a code reference");
162					}
163					}
164					else {
165					$^H{$_[0]} = $_[1];
166					$^H \|= $constants{$_[0]};
167					}
168					shift, shift;
169					}
170					}
171
172					sub remove_constant {
173					# Arguments: what, sub
174					while (@_) {
175					delete $^H{$_[0]};
176					$^H &= ~ $constants{$_[0]};
177					shift, shift;
178					}
179					}
180
181	1	7µs			1;
182
183					__END__