← Index
NYTProf Performance Profile   « block view • line view • sub view »
For reply.pl
  Run on Thu Oct 21 22:40:13 2010
Reported on Thu Oct 21 22:44:40 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/5.13.5/overload.pm
StatementsExecuted 37 statements in 308µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
21166µs66µsoverload::::OVERLOADoverload::OVERLOAD
22129µs95µsoverload::::importoverload::import
11127µs225µsoverload::::BEGIN@145overload::BEGIN@145
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
0000s0soverload::::unimportoverload::unimport
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
311µsour $VERSION = '1.10';
4
5sub nil {}
6
7
# spent 66µs within overload::OVERLOAD which was called 2 times, avg 33µs/call: # 2 times (66µs+0s) by overload::import at line 34, avg 33µs/call
sub OVERLOAD {
81652µs $package = shift;
9 my %arg = @_;
10 my ($sub, $fb);
11 $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
12 $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
13 *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
14 for (keys %arg) {
15819µs if ($_ eq 'fallback') {
16 $fb = $arg{$_};
17 } else {
18 $sub = $arg{$_};
19 if (not ref $sub and $sub !~ /::/) {
20 $ {$package . "::(" . $_} = $sub;
21 $sub = \&nil;
22 }
23 #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
24 *{$package . "::(" . $_} = \&{ $sub };
25 }
26 }
27 ${$package . "::()"} = $fb; # Make it findable too (fallback only).
28}
29
30
# spent 95µs (29+66) within overload::import which was called 2 times, avg 48µs/call: # once (17µs+36µs) by Regexp::Common::BEGIN@163 at line 163 of Regexp/Common.pm # once (12µs+30µs) by Regexp::Common::Entry::BEGIN@257 at line 268 of Regexp/Common.pm
sub import {
31627µs $package = (caller())[0];
32 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
33 shift;
34266µs $package->overload::OVERLOAD(@_);
# spent 66µs making 2 calls to overload::OVERLOAD, avg 33µs/call
35}
36
37sub unimport {
38 $package = (caller())[0];
39 ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
40 shift;
41 for (@_) {
42 if ($_ eq 'fallback') {
43 undef $ {$package . "::()"};
44 } else {
45 delete $ {$package . "::"}{"(" . $_};
46 }
47 }
48}
49
50sub Overloaded {
51 my $package = shift;
52 $package = ref $package if ref $package;
53 $package->can('()');
54}
55
56sub ov_method {
57 my $globref = shift;
58 return undef unless $globref;
59 my $sub = \&{*$globref};
60 return $sub if $sub ne \&nil;
61 return shift->can($ {*$globref});
62}
63
64sub OverloadedStringify {
65 my $package = shift;
66 $package = ref $package if ref $package;
67 #$package->can('(""')
68 ov_method mycan($package, '(""'), $package
69 or ov_method mycan($package, '(0+'), $package
70 or ov_method mycan($package, '(bool'), $package
71 or ov_method mycan($package, '(nomethod'), $package;
72}
73
74sub Method {
75 my $package = shift;
76 if(ref $package) {
77 local $@;
78 local $!;
79 require Scalar::Util;
80 $package = Scalar::Util::blessed($package);
81 return undef if !defined $package;
82 }
83 #my $meth = $package->can('(' . shift);
84 ov_method mycan($package, '(' . shift), $package;
85 #return $meth if $meth ne \&nil;
86 #return $ {*{$meth}};
87}
88
89sub AddrRef {
90 my $package = ref $_[0];
91 return "$_[0]" unless $package;
92
93 local $@;
94 local $!;
95 require Scalar::Util;
96 my $class = Scalar::Util::blessed($_[0]);
97 my $class_prefix = defined($class) ? "$class=" : "";
98 my $type = Scalar::Util::reftype($_[0]);
99 my $addr = Scalar::Util::refaddr($_[0]);
100 return sprintf("$class_prefix$type(0x%x)", $addr);
101}
102
10312µs*StrVal = *AddrRef;
104
105sub mycan { # Real can would leave stubs.
106 my ($package, $meth) = @_;
107
108 local $@;
109 local $!;
110 require mro;
111
112 my $mro = mro::get_linear_isa($package);
113 foreach my $p (@$mro) {
114 my $fqmeth = $p . q{::} . $meth;
115 return \*{$fqmeth} if defined &{$fqmeth};
116 }
117
118 return undef;
119}
120
12113µs%constants = (
122 'integer' => 0x1000, # HINT_NEW_INTEGER
123 'float' => 0x2000, # HINT_NEW_FLOAT
124 'binary' => 0x4000, # HINT_NEW_BINARY
125 'q' => 0x8000, # HINT_NEW_STRING
126 'qr' => 0x10000, # HINT_NEW_RE
127 );
128
12918µs%ops = ( with_assign => "+ - * / % ** << >> x .",
130 assign => "+= -= *= /= %= **= <<= >>= x= .=",
131 num_comparison => "< <= > >= == !=",
132 '3way_comparison'=> "<=> cmp",
133 str_comparison => "lt le gt ge eq ne",
134 binary => '& &= | |= ^ ^=',
135 unary => "neg ! ~",
136 mutators => '++ --',
137 func => "atan2 cos sin exp abs log sqrt int",
138 conversion => 'bool "" 0+ qr',
139 iterators => '<>',
140 filetest => "-X",
141 dereferencing => '${} @{} %{} &{} *{}',
142 matching => '~~',
143 special => 'nomethod fallback =');
144
1452189µs2423µs
# spent 225µs (27+198) within overload::BEGIN@145 which was called: # once (27µs+198µs) by Data::OptList::BEGIN@7 at line 145
use warnings::register;
# spent 225µs making 1 call to overload::BEGIN@145 # spent 198µs making 1 call to warnings::register::import
146sub 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
172sub remove_constant {
173 # Arguments: what, sub
174 while (@_) {
175 delete $^H{$_[0]};
176 $^H &= ~ $constants{$_[0]};
177 shift, shift;
178 }
179}
180
18117µs1;
182
183__END__