Profile of overload.pm

Filename	/usr/local/perls/perl-5.26.1/lib/5.26.1/overload.pm
Statements	Executed 46 statements in 198µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
2	1	1	144µs	144µs	overload::::OVERLOADoverload::OVERLOAD
2	2	2	55µs	199µs	overload::::importoverload::import
0	0	0	0s	0s	overload::::AddrRefoverload::AddrRef
0	0	0	0s	0s	overload::::BEGINoverload::BEGIN
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					our $VERSION = '1.28';
4
5					%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					my %ops_seen;
24					@ops_seen{ map split(/ /), values %ops } = ();
25
26					sub nil {}
27
28					# spent 144µs within overload::OVERLOAD which was called 2 times, avg 72µs/call: # 2 times (144µs+0s) by overload::import at line 57, avg 72µs/call sub OVERLOAD {
29	2	1µs			$package = shift;
30	2	10µs			my %arg = @_;
31	2	1µs			my $sub;
32	2	28µs			*{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
33	2	22µs			for (keys %arg) {
34	6	9µs			if ($_ eq 'fallback') {
35	2	16µs			for my $sym (*{$package . "::()"}) {
36	2	3µs			*$sym = \&nil; # Make it findable via fetchmethod.
37	2	4µs			$$sym = $arg{$_};
38					}
39					} else {
40					warnings::warnif("overload arg '$_' is invalid")
41	4	4µs			unless exists $ops_seen{$_};
42	4	4µs			$sub = $arg{$_};
43	4	6µs			if (not ref $sub) {
44	1	3µs			$ {$package . "::(" . $_} = $sub;
45	1	1µs			$sub = \&nil;
46					}
47					#print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
48	4	37µs			*{$package . "::(" . $_} = \&{ $sub };
49					}
50					}
51					}
52
53					# spent 199µs (55+144) within overload::import which was called 2 times, avg 99µs/call: # once (44µs+114µs) by URI::BEGIN@25 at line 29 of URI.pm # once (11µs+30µs) by URI::WithBase::BEGIN@11 at line 11 of URI/WithBase.pm sub import {
54	2	20µs			$package = (caller())[0];
55					# *{$package . "::OVERLOAD"} = \&OVERLOAD;
56	2	0s			shift;
57	2	29µs	2	144µs	$package->overload::OVERLOAD(@_); # spent 144µs making 2 calls to overload::OVERLOAD, avg 72µs/call
58					}
59
60					sub unimport {
61					$package = (caller())[0];
62					shift;
63					*{$package . "::(("} = \&nil;
64					for (@_) {
65					warnings::warnif("overload arg '$_' is invalid")
66					unless exists $ops_seen{$_};
67					delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
68					}
69					}
70
71					sub Overloaded {
72					my $package = shift;
73					$package = ref $package if ref $package;
74					mycan ($package, '()') \|\| mycan ($package, '((');
75					}
76
77					sub ov_method {
78					my $globref = shift;
79					return undef unless $globref;
80					my $sub = \&{*$globref};
81					no overloading;
82					return $sub if $sub != \&nil;
83					return shift->can($ {*$globref});
84					}
85
86					sub OverloadedStringify {
87					my $package = shift;
88					$package = ref $package if ref $package;
89					#$package->can('(""')
90					ov_method mycan($package, '(""'), $package
91					or ov_method mycan($package, '(0+'), $package
92					or ov_method mycan($package, '(bool'), $package
93					or ov_method mycan($package, '(nomethod'), $package;
94					}
95
96					sub Method {
97					my $package = shift;
98					if(ref $package) {
99					local $@;
100					local $!;
101					require Scalar::Util;
102					$package = Scalar::Util::blessed($package);
103					return undef if !defined $package;
104					}
105					#my $meth = $package->can('(' . shift);
106					ov_method mycan($package, '(' . shift), $package;
107					#return $meth if $meth ne \&nil;
108					#return $ {*{$meth}};
109					}
110
111					sub AddrRef {
112					no overloading;
113					"$_[0]";
114					}
115
116					StrVal = AddrRef;
117
118					sub mycan { # Real can would leave stubs.
119					my ($package, $meth) = @_;
120
121					local $@;
122					local $!;
123					require mro;
124
125					my $mro = mro::get_linear_isa($package);
126					foreach my $p (@$mro) {
127					my $fqmeth = $p . q{::} . $meth;
128					return \*{$fqmeth} if defined &{$fqmeth};
129					}
130
131					return undef;
132					}
133
134					%constants = (
135					'integer' => 0x1000, # HINT_NEW_INTEGER
136					'float' => 0x2000, # HINT_NEW_FLOAT
137					'binary' => 0x4000, # HINT_NEW_BINARY
138					'q' => 0x8000, # HINT_NEW_STRING
139					'qr' => 0x10000, # HINT_NEW_RE
140					);
141
142					use warnings::register;
143					sub constant {
144					# Arguments: what, sub
145					while (@_) {
146					if (@_ == 1) {
147					warnings::warnif ("Odd number of arguments for overload::constant");
148					last;
149					}
150					elsif (!exists $constants {$_ [0]}) {
151					warnings::warnif ("'$_[0]' is not an overloadable type");
152					}
153					elsif (!ref $_ [1] \|\| "$_[1]" !~ /(^\|=)CODE$0x[0-9a-f]+$$/) {
154					# Can't use C<ref $_[1] eq "CODE"> above as code references can be
155					# blessed, and C<ref> would return the package the ref is blessed into.
156					if (warnings::enabled) {
157					$_ [1] = "undef" unless defined $_ [1];
158					warnings::warn ("'$_[1]' is not a code reference");
159					}
160					}
161					else {
162					$^H{$_[0]} = $_[1];
163					$^H \|= $constants{$_[0]};
164					}
165					shift, shift;
166					}
167					}
168
169					sub remove_constant {
170					# Arguments: what, sub
171					while (@_) {
172					delete $^H{$_[0]};
173					$^H &= ~ $constants{$_[0]};
174					shift, shift;
175					}
176					}
177
178					1;
179
180					__END__