← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:08 2010

File /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm
Statements Executed 398
Total Time 0.0030435 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
45211.01ms10.2msClass::MOP::Method::Inlined::::can_be_inlinedClass::MOP::Method::Inlined::can_be_inlined
811107µs1.06msClass::MOP::Method::Inlined::::_uninlined_bodyClass::MOP::Method::Inlined::_uninlined_body
0000s0sClass::MOP::Method::Inlined::::BEGINClass::MOP::Method::Inlined::BEGIN
LineStmts.Exclusive
Time
Avg.Code
1package Class::MOP::Method::Inlined;
2
3323µs8µsuse strict;
# spent 7µs making 1 call to strict::import
4333µs11µsuse warnings;
# spent 25µs making 1 call to warnings::import
5
6352µs18µsuse Carp 'confess';
# spent 38µs making 1 call to Exporter::import
7379µs26µsuse Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
# spent 74µs making 1 call to Exporter::import
8
911µs1µsour $VERSION = '1.09';
10122µs22µs$VERSION = eval $VERSION;
111500ns500nsour $AUTHORITY = 'cpan:STEVAN';
12
133475µs158µsuse base 'Class::MOP::Method::Generated';
# spent 75µs making 1 call to base::import, max recursion depth 1
14
154597µs2µssub _expected_method_class { $_[0]{_expected_method_class} }
16
17
# spent 1.06ms (107µs+950µs) within Class::MOP::Method::Inlined::_uninlined_body which was called 8 times, avg 132µs/call: # 8 times (107µs+950µs) by Class::MOP::Method::Inlined::can_be_inlined at line 79, avg 132µs/call
sub _uninlined_body {
1824167µs7µs my $self = shift;
19
20 my $super_method
# spent 825µs making 8 calls to Class::MOP::Class::find_next_method_by_name, avg 103µs/call # spent 32µs making 8 calls to Class::MOP::Method::associated_metaclass, avg 4µs/call # spent 29µs making 8 calls to Class::MOP::Method::name, avg 4µs/call
21 = $self->associated_metaclass->find_next_method_by_name( $self->name )
22 or return;
23
24841µs5µs if ( $super_method->isa(__PACKAGE__) ) {
# spent 44µs making 8 calls to UNIVERSAL::isa, avg 6µs/call
25 return $super_method->_uninlined_body;
26 }
27 else {
28 return $super_method->body;
# spent 20µs making 8 calls to Class::MOP::Method::body, avg 2µs/call
29 }
30}
31
32
# spent 10.2ms (1.01+9.17) within Class::MOP::Method::Inlined::can_be_inlined which was called 45 times, avg 226µs/call: # 38 times (872µs+8.12ms) by Class::MOP::Class::_inline_constructor at line 1306 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 237µs/call # 7 times (140µs+1.05ms) by Class::MOP::Class::_inline_destructor at line 1339 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 170µs/call
sub can_be_inlined {
333022.05ms7µs my $self = shift;
34 my $metaclass = $self->associated_metaclass;
# spent 134µs making 31 calls to Class::MOP::Method::Constructor::associated_metaclass, avg 4µs/call # spent 57µs making 14 calls to Class::MOP::Method::associated_metaclass, avg 4µs/call
35 my $class = $metaclass->name;
# spent 183µs making 45 calls to Class::MOP::Package::name, avg 4µs/call
36
37 # If we don't find an inherited method, this is a rather weird
38 # case where we have no method in the inheritance chain even
39 # though we're expecting one to be there
40 my $inherited_method
# spent 6.81ms making 45 calls to Class::MOP::Class::find_next_method_by_name, avg 151µs/call # spent 158µs making 45 calls to Class::MOP::Method::name, avg 4µs/call
41 = $metaclass->find_next_method_by_name( $self->name );
42
43 if ( $inherited_method
# spent 352µs making 42 calls to UNIVERSAL::isa, avg 8µs/call
44 && $inherited_method->isa('Class::MOP::Method::Wrapped') ) {
45 warn "Not inlining '"
46 . $self->name
47 . "' for $class since it "
48 . "has method modifiers which would be lost if it were inlined\n";
49
50 return 0;
51 }
52
53 my $expected_class = $self->_expected_method_class
# spent 225µs making 45 calls to Class::MOP::Method::Inlined::_expected_method_class, avg 5µs/call
54 or return 1;
55
56 # if we are shadowing a method we first verify that it is
57 # compatible with the definition we are replacing it with
58 my $expected_method = $expected_class->can( $self->name );
# spent 27µs making 7 calls to UNIVERSAL::can, avg 4µs/call # spent 21µs making 7 calls to Class::MOP::Method::name, avg 3µs/call
59
60 if ( ! $expected_method ) {
61 warn "Not inlining '"
62 . $self->name
63 . "' for $class since ${expected_class}::"
64 . $self->name
65 . " is not defined\n";
66
67 return 0;
68 }
69
70 my $actual_method = $class->can( $self->name )
# spent 32µs making 7 calls to UNIVERSAL::can, avg 4µs/call # spent 19µs making 7 calls to Class::MOP::Method::name, avg 3µs/call
71 or return 1;
72
73 # the method is what we wanted (probably Moose::Object::new)
74 return 1
# spent 42µs making 14 calls to Scalar::Util::refaddr, avg 3µs/call
75 if refaddr($expected_method) == refaddr($actual_method);
76
77 # otherwise we have to check that the actual method is an inlined
78 # version of what we're expecting
79 if ( $inherited_method->isa(__PACKAGE__) ) {
# spent 1.06ms making 8 calls to Class::MOP::Method::Inlined::_uninlined_body, avg 132µs/call # spent 28µs making 4 calls to UNIVERSAL::isa, avg 7µs/call # spent 22µs making 8 calls to Scalar::Util::refaddr, avg 3µs/call
80 if ( $inherited_method->_uninlined_body
81 && refaddr( $inherited_method->_uninlined_body )
82 == refaddr($expected_method) ) {
83 return 1;
84 }
85 }
86 elsif ( refaddr( $inherited_method->body )
87 == refaddr($expected_method) ) {
88 return 1;
89 }
90
91 my $warning
92 = "Not inlining '"
93 . $self->name
94 . "' for $class since it is not"
95 . " inheriting the default ${expected_class}::"
96 . $self->name . "\n";
97
98 if ( $self->isa("Class::MOP::Method::Constructor") ) {
99
100 # FIXME kludge, refactor warning generation to a method
101 $warning
102 .= "If you are certain you don't need to inline your"
103 . " constructor, specify inline_constructor => 0 in your"
104 . " call to $class->meta->make_immutable\n";
105 }
106
107 warn $warning;
108
109 return 0;
110}
111
11214µs4µs1;
113
114__END__
115
116=pod
117
118=head1 NAME
119
120Class::MOP::Method::Inlined - Method base class for methods which have been inlined
121
122=head1 DESCRIPTION
123
124This is a L<Class::MOP::Method::Generated> subclass for methods which
125can be inlined.
126
127=head1 METHODS
128
129=over 4
130
131=item B<< $metamethod->can_be_inlined >>
132
133This method returns true if the method in question can be inlined in
134the associated metaclass.
135
136If it cannot be inlined, it spits out a warning and returns false.
137
138=back
139
140=head1 AUTHORS
141
142Stevan Little E<lt>stevan@iinteractive.comE<gt>
143
144=head1 COPYRIGHT AND LICENSE
145
146Copyright 2006-2010 by Infinity Interactive, Inc.
147
148L<http://www.iinteractive.com>
149
150This library is free software; you can redistribute it and/or modify
151it under the same terms as Perl itself.
152
153=cut
154