Profile of overload.pm

← Index
NYTProf Performance Profile «line view»
For t/bug-md-11.t
Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/5.38.2/overload.pm
Statements | Executed 161 statements in 875µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
6 | 1 | 1 | 70µs | 70µs | overload::::OVERLOADoverload::OVERLOAD
6 | 6 | 5 | 26µs | 96µs | overload::::importoverload::import
1 | 1 | 1 | 12µs | 12µs | overload::::unimportoverload::unimport
1 | 1 | 1 | 9µs | 10µs | overload::::BEGIN@3overload::BEGIN@3
1 | 1 | 1 | 7µs | 14µs | overload::::BEGIN@84overload::BEGIN@84
1 | 1 | 1 | 5µs | 9µs | overload::::BEGIN@113overload::BEGIN@113
1 | 1 | 1 | 4µs | 17µs | overload::::BEGIN@102overload::BEGIN@102
1 | 1 | 1 | 4µs | 18µs | overload::::BEGIN@143overload::BEGIN@143
1 | 1 | 1 | 3µs | 7µ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

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