Profile of overload.pm

← Index
NYTProf Performance Profile «line view»
For -e
Run on Thu Jun 30 16:34:56 2016
Reported on Thu Jun 30 16:35:09 2016

Filename | /home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/5.22.1/overload.pm
Statements | Executed 136 statements in 933µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 500µs | 531µs | overload::::BEGIN@83overload::BEGIN@83
2 | 1 | 1 | 74µs | 74µs | overload::::OVERLOADoverload::OVERLOAD
2 | 2 | 2 | 18µs | 92µs | overload::::importoverload::import
1 | 1 | 1 | 9µs | 15µs | overload::::BEGIN@114overload::BEGIN@114
1 | 1 | 1 | 8µs | 96µs | overload::::BEGIN@144overload::BEGIN@144
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 | 400ns |  |  | our $VERSION = '1.26';
4 |  |  |  |  |
5 | 1 | 7µ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 | 200ns |  |  | my %ops_seen;
24 | 1 | 3µs |  |  | for $category (keys %ops) {
25 | 15 | 66µs |  |  | $ops_seen{$_}++ for (split /\s+/, $ops{$category});
26 |  |  |  |  | }
27 |  |  |  |  |
28 |  |  |  |  | sub nil {}
29 |  |  |  |  |
30 |  |  |  |  | # spent 74µs within overload::OVERLOAD which was called 2 times, avg 37µs/call: # 2 times (74µs+0s) by overload::import at line 59, avg 37µs/call sub OVERLOAD {
31 | 2 | 500ns |  |  | $package = shift;
32 | 2 | 6µs |  |  | my %arg = @_;
33 | 2 | 400ns |  |  | my $sub;
34 | 2 | 7µs |  |  | *{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
35 | 2 | 14µs |  |  | for (keys %arg) {
36 | 14 | 6µs |  |  | if ($_ eq 'fallback') {
37 | 2 | 4µs |  |  | for my $sym (*{$package . "::()"}) {
38 | 2 | 1µs |  |  | *$sym = \&nil; # Make it findable via fetchmethod.
39 | 2 | 2µs |  |  | $$sym = $arg{$_};
40 |  |  |  |  | }
41 |  |  |  |  | } else {
42 |  |  |  |  | warnings::warnif("overload arg '$_' is invalid")
43 | 12 | 4µs |  |  | unless $ops_seen{$_};
44 | 12 | 3µs |  |  | $sub = $arg{$_};
45 | 12 | 3µs |  |  | if (not ref $sub) {
46 | 12 | 17µs |  |  | $ {$package . "::(" . $_} = $sub;
47 | 12 | 3µs |  |  | $sub = \&nil;
48 |  |  |  |  | }
49 |  |  |  |  | #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
50 | 12 | 9µs |  |  | *{$package . "::(" . $_} = \&{ $sub };
51 |  |  |  |  | }
52 |  |  |  |  | }
53 |  |  |  |  | }
54 |  |  |  |  |
55 |  |  |  |  | # spent 92µs (18+74) within overload::import which was called 2 times, avg 46µs/call: # once (10µs+42µs) by DateTime::BEGIN@57 at line 58 of DateTime.pm # once (9µs+32µs) by DateTime::Duration::BEGIN@13 at line 14 of DateTime/Duration.pm sub import {
56 | 2 | 3µs |  |  | $package = (caller())[0];
57 |  |  |  |  | # *{$package . "::OVERLOAD"} = \&OVERLOAD;
58 | 2 | 500ns |  |  | shift;
59 | 2 | 10µs | 2 | 74µs | $package->overload::OVERLOAD(@_); # spent 74µs making 2 calls to overload::OVERLOAD, avg 37µs/call
60 |  |  |  |  | }
61 |  |  |  |  |
62 |  |  |  |  | sub 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 |  |  |  |  |
73 |  |  |  |  | sub Overloaded {
74 |  |  |  |  | my $package = shift;
75 |  |  |  |  | $package = ref $package if ref $package;
76 |  |  |  |  | mycan ($package, '()') || mycan ($package, '((');
77 |  |  |  |  | }
78 |  |  |  |  |
79 |  |  |  |  | sub ov_method {
80 |  |  |  |  | my $globref = shift;
81 |  |  |  |  | return undef unless $globref;
82 |  |  |  |  | my $sub = \&{*$globref};
83 | 2 | 396µs | 2 | 539µs | # spent 531µs (500+31) within overload::BEGIN@83 which was called: # once (500µs+31µs) by DateTime::Duration::BEGIN@13 at line 83 no overloading; # spent 531µs making 1 call to overload::BEGIN@83 # spent 8µs making 1 call to overloading::unimport
84 |  |  |  |  | return $sub if $sub != \&nil;
85 |  |  |  |  | return shift->can($ {*$globref});
86 |  |  |  |  | }
87 |  |  |  |  |
88 |  |  |  |  | sub 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 |  |  |  |  |
98 |  |  |  |  | sub 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 |  |  |  |  | sub AddrRef {
114 | 2 | 137µs | 2 | 22µs | # spent 15µs (9+7) within overload::BEGIN@114 which was called: # once (9µs+7µs) by DateTime::Duration::BEGIN@13 at line 114 no overloading; # spent 15µs making 1 call to overload::BEGIN@114 # spent 7µs making 1 call to overloading::unimport
115 |  |  |  |  | "$_[0]";
116 |  |  |  |  | }
117 |  |  |  |  |
118 | 1 | 2µs |  |  | *StrVal = *AddrRef;
119 |  |  |  |  |
120 |  |  |  |  | sub 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 |  |  |  |  |
136 | 1 | 2µ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 |  |  |  |  |
144 | 2 | 217µs | 2 | 184µs | # spent 96µs (8+88) within overload::BEGIN@144 which was called: # once (8µs+88µs) by DateTime::Duration::BEGIN@13 at line 144 use warnings::register; # spent 96µs making 1 call to overload::BEGIN@144 # spent 88µs making 1 call to warnings::register::import
145 |  |  |  |  | sub 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 |  |  |  |  |
171 |  |  |  |  | sub remove_constant {
172 |  |  |  |  | # Arguments: what, sub
173 |  |  |  |  | while (@_) {
174 |  |  |  |  | delete $^H{$_[0]};
175 |  |  |  |  | $^H &= ~ $constants{$_[0]};
176 |  |  |  |  | shift, shift;
177 |  |  |  |  | }
178 |  |  |  |  | }
179 |  |  |  |  |
180 | 1 | 9µs |  |  | 1;
181 |  |  |  |  |
182 |  |  |  |  | __END__