← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:06 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Devel/OverloadInfo.pm
StatementsExecuted 21 statements in 486µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111380µs558µsDevel::OverloadInfo::::BEGIN@18Devel::OverloadInfo::BEGIN@18
11116µs25µsDevel::OverloadInfo::::BEGIN@19Devel::OverloadInfo::BEGIN@19
11110µs22µsDevel::OverloadInfo::::BEGIN@22Devel::OverloadInfo::BEGIN@22
1118µs10µsDevel::OverloadInfo::::BEGIN@14Devel::OverloadInfo::BEGIN@14
1114µs4µsDevel::OverloadInfo::::BEGIN@20Devel::OverloadInfo::BEGIN@20
1114µs24µsDevel::OverloadInfo::::BEGIN@17Devel::OverloadInfo::BEGIN@17
1114µs7µsDevel::OverloadInfo::::BEGIN@15Devel::OverloadInfo::BEGIN@15
1112µs2µsDevel::OverloadInfo::::BEGIN@16Devel::OverloadInfo::BEGIN@16
0000s0sDevel::OverloadInfo::::is_overloadedDevel::OverloadInfo::is_overloaded
0000s0sDevel::OverloadInfo::::overload_infoDevel::OverloadInfo::overload_info
0000s0sDevel::OverloadInfo::::stash_with_symbolDevel::OverloadInfo::stash_with_symbol
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Devel::OverloadInfo;
21300ns$Devel::OverloadInfo::VERSION = '0.004';
3# ABSTRACT: introspect overloaded operators
4
5#pod =head1 DESCRIPTION
6#pod
7#pod Devel::OverloadInfo returns information about L<overloaded|overload>
8#pod operators for a given class (or object), including where in the
9#pod inheritance hierarchy the overloads are declared and where the code
10#pod implementing it is.
11#pod
12#pod =cut
13
14214µs212µs
# spent 10µs (8+2) within Devel::OverloadInfo::BEGIN@14 which was called: # once (8µs+2µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 14
use strict;
# spent 10µs making 1 call to Devel::OverloadInfo::BEGIN@14 # spent 2µs making 1 call to strict::import
15212µs210µs
# spent 7µs (4+3) within Devel::OverloadInfo::BEGIN@15 which was called: # once (4µs+3µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 15
use warnings;
# spent 7µs making 1 call to Devel::OverloadInfo::BEGIN@15 # spent 3µs making 1 call to warnings::import
16212µs12µs
# spent 2µs within Devel::OverloadInfo::BEGIN@16 which was called: # once (2µs+0s) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 16
use overload ();
# spent 2µs making 1 call to Devel::OverloadInfo::BEGIN@16
17216µs244µs
# spent 24µs (4+20) within Devel::OverloadInfo::BEGIN@17 which was called: # once (4µs+20µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 17
use Scalar::Util qw(blessed);
# spent 24µs making 1 call to Devel::OverloadInfo::BEGIN@17 # spent 20µs making 1 call to Exporter::import
18264µs2585µs
# spent 558µs (380+178) within Devel::OverloadInfo::BEGIN@18 which was called: # once (380µs+178µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 18
use Sub::Identify qw(sub_fullname);
# spent 558µs making 1 call to Devel::OverloadInfo::BEGIN@18 # spent 27µs making 1 call to Exporter::import
19339µs233µs
# spent 25µs (16+8) within Devel::OverloadInfo::BEGIN@19 which was called: # once (16µs+8µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 19
use Package::Stash 0.14;
# spent 25µs making 1 call to Devel::OverloadInfo::BEGIN@19 # spent 8µs making 1 call to UNIVERSAL::VERSION
20229µs14µs
# spent 4µs within Devel::OverloadInfo::BEGIN@20 which was called: # once (4µs+0s) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 20
use MRO::Compat;
# spent 4µs making 1 call to Devel::OverloadInfo::BEGIN@20
21
223296µs333µs
# spent 22µs (10+11) within Devel::OverloadInfo::BEGIN@22 which was called: # once (10µs+11µs) by Class::MOP::Mixin::HasOverloads::BEGIN@9 at line 22
use Exporter 5.57 qw(import);
# spent 22µs making 1 call to Devel::OverloadInfo::BEGIN@22 # spent 6µs making 1 call to UNIVERSAL::VERSION # spent 6µs making 1 call to Exporter::import
231600nsour @EXPORT_OK = qw(overload_info is_overloaded);
24
25sub stash_with_symbol {
26 my ($class, $symbol) = @_;
27
28 for my $package (@{mro::get_linear_isa($class)}) {
29 my $stash = Package::Stash->new($package);
30 my $value_ref = $stash->get_symbol($symbol);
31 return ($stash, $value_ref) if $value_ref;
32 }
33 return;
34}
35
36#pod =func is_overloaded
37#pod
38#pod if (is_overloaded($class_or_object)) { ... }
39#pod
40#pod Returns a boolean indicating whether the given class or object has any
41#pod overloading declared. Note that a bare C<use overload;> with no
42#pod actual operators counts as being overloaded.
43#pod
44#pod Equivalent to
45#pod L<overload::Overloaded()|overload/overload::Overloaded(arg)>, but
46#pod doesn't trigger various bugs associated with it in versions of perl
47#pod before 5.16.
48#pod
49#pod =cut
50
51sub is_overloaded {
52 my $class = blessed($_[0]) || $_[0];
53
54 # Perl before 5.16 seems to corrupt inherited overload info if
55 # there's a lone dereference overload and overload::Overloaded()
56 # is called before any object has been blessed into the class.
57 return !!("$]" >= 5.016
58 ? overload::Overloaded($class)
59 : stash_with_symbol($class, '&()')
60 );
61}
62
63#pod =func overload_info
64#pod
65#pod my $info = overload_info($class_or_object);
66#pod
67#pod Returns a hash reference with information about all the overloaded
68#pod operators of the argument, which can be either a class name or a blessed
69#pod object. The keys are the overloaded operators, as specified in
70#pod C<%overload::ops> (see L<overload/Overloadable Operations>).
71#pod
72#pod =over
73#pod
74#pod =item class
75#pod
76#pod The name of the class in which the operator overloading was declared.
77#pod
78#pod =item code
79#pod
80#pod A reference to the function implementing the overloaded operator.
81#pod
82#pod =item code_name
83#pod
84#pod The name of the function implementing the overloaded operator, as
85#pod returned by C<sub_fullname> in L<Sub::Identify>.
86#pod
87#pod =item method_name (optional)
88#pod
89#pod The name of the method implementing the overloaded operator, if the
90#pod overloading was specified as a named method, e.g. C<< use overload $op
91#pod => 'method'; >>.
92#pod
93#pod =item code_class (optional)
94#pod
95#pod The name of the class in which the method specified by C<method_name>
96#pod was found.
97#pod
98#pod =item value (optional)
99#pod
100#pod For the special C<fallback> key, the value it was given in C<class>.
101#pod
102#pod =back
103#pod
104#pod =cut
105
106sub overload_info {
107 my $class = blessed($_[0]) || $_[0];
108
109 return {} unless is_overloaded($class);
110
111 my (%overloaded);
112 for my $op (map split(/\s+/), values %overload::ops) {
113 my $op_method = $op eq 'fallback' ? "()" : "($op";
114 my ($stash, $func) = stash_with_symbol($class, "&$op_method")
115 or next;
116 my $info = $overloaded{$op} = {
117 class => $stash->name,
118 };
119 if ($func == \&overload::nil) {
120 # Named method or fallback, stored in the scalar slot
121 if (my $value_ref = $stash->get_symbol("\$$op_method")) {
122 my $value = $$value_ref;
123 if ($op eq 'fallback') {
124 $info->{value} = $value;
125 } else {
126 $info->{method_name} = $value;
127 if (my ($impl_stash, $impl_func) = stash_with_symbol($class, "&$value")) {
128 $info->{code_class} = $impl_stash->name;
129 $info->{code} = $impl_func;
130 }
131 }
132 }
133 } else {
134 $info->{code} = $func;
135 }
136 $info->{code_name} = sub_fullname($info->{code})
137 if exists $info->{code};
138 }
139 return \%overloaded;
140}
141
142#pod =head1 CAVEATS
143#pod
144#pod Whether the C<fallback> key exists when it has its default value of
145#pod C<undef> varies between perl versions: Before 5.18 it's there, in
146#pod later versions it's not.
147#pod
148#pod =cut
149
15013µs1;
151
152__END__