← 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
StatementsExecuted 161 statements in 875µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
61170µs70µsoverload::::OVERLOADoverload::OVERLOAD
66526µs96µsoverload::::importoverload::import
11112µs12µsoverload::::unimportoverload::unimport
1119µs10µsoverload::::BEGIN@3overload::BEGIN@3
1117µs14µsoverload::::BEGIN@84overload::BEGIN@84
1115µs9µsoverload::::BEGIN@113overload::BEGIN@113
1114µs17µsoverload::::BEGIN@102overload::BEGIN@102
1114µs18µsoverload::::BEGIN@143overload::BEGIN@143
1113µs7µsoverload::::BEGIN@4overload::BEGIN@4
0000s0soverload::::AddrRefoverload::AddrRef
0000s0soverload::::Methodoverload::Method
0000s0soverload::::Overloadedoverload::Overloaded
0000s0soverload::::OverloadedStringifyoverload::OverloadedStringify
0000s0soverload::::constantoverload::constant
0000s0soverload::::mycanoverload::mycan
0000s0soverload::::niloverload::nil
0000s0soverload::::ov_methodoverload::ov_method
0000s0soverload::::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
1package overload;
2
3218µs212µ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
42307µs210µ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
61300nsour $VERSION = '1.37';
7
814µsour %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
261200nsmy %ops_seen;
27123µs@ops_seen{ map split(/ /), values %ops } = ();
28
29sub 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 {
3261µs my $package = shift;
3366µs my %arg = @_;
346900ns my $sub;
35612µs *{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
36621µs for (keys %arg) {
37167µs if ($_ eq 'fallback') {
3846µs for my $sym (*{$package . "::()"}) {
3942µs *$sym = \&nil; # Make it findable via fetchmethod.
4042µs $$sym = $arg{$_};
41 }
42 } else {
43 warnings::warnif("overload arg '$_' is invalid")
44123µs unless exists $ops_seen{$_};
45123µs $sub = $arg{$_};
46122µs if (not ref $sub) {
4733µs $ {$package . "::(" . $_} = $sub;
483700ns $sub = \&nil;
49 }
50 #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
511210µ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 {
5764µs my $package = caller();
58 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
5961µs shift;
60616µs670µ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 {
641600ns my $package = caller();
651200ns shift;
6613µs *{$package . "::(("} = \&nil;
6714µs for (@_) {
68 warnings::warnif("overload arg '$_' is invalid")
6942µs unless exists $ops_seen{$_};
7043µs delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
71 }
72}
73
74sub Overloaded {
75 my $package = shift;
76 $package = ref $package if ref $package;
77 mycan ($package, '()') || mycan ($package, '((');
78}
79
80sub ov_method {
81 my $globref = shift;
82 return undef unless $globref;
83 my $sub = \&{*$globref};
84298µs220µ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
89sub 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
99sub Method {
100 my $package = shift;
101 if (ref $package) {
102247µs230µ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
112sub AddrRef {
113293µs214µ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
11711µs*StrVal = *AddrRef;
118
119sub 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
13511µsmy %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
1432163µs233µ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
144sub 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
170sub remove_constant {
171 # Arguments: what, sub
172 while (@_) {
173 delete $^H{$_[0]};
174 $^H &= ~ $constants{$_[0]};
175 shift, shift;
176 }
177}
178
17916µs1;
180
181__END__