| File | /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm |
| Statements Executed | 398 |
| Total Time | 0.0030435 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 45 | 2 | 1 | 1.01ms | 10.2ms | Class::MOP::Method::Inlined::can_be_inlined |
| 8 | 1 | 1 | 107µs | 1.06ms | Class::MOP::Method::Inlined::_uninlined_body |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Method::Inlined::BEGIN |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package Class::MOP::Method::Inlined; | |||
| 2 | ||||
| 3 | 3 | 23µs | 8µs | use strict; # spent 7µs making 1 call to strict::import |
| 4 | 3 | 33µs | 11µs | use warnings; # spent 25µs making 1 call to warnings::import |
| 5 | ||||
| 6 | 3 | 52µs | 18µs | use Carp 'confess'; # spent 38µs making 1 call to Exporter::import |
| 7 | 3 | 79µs | 26µs | use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr'; # spent 74µs making 1 call to Exporter::import |
| 8 | ||||
| 9 | 1 | 1µs | 1µs | our $VERSION = '1.09'; |
| 10 | 1 | 22µs | 22µs | $VERSION = eval $VERSION; |
| 11 | 1 | 500ns | 500ns | our $AUTHORITY = 'cpan:STEVAN'; |
| 12 | ||||
| 13 | 3 | 475µs | 158µs | use base 'Class::MOP::Method::Generated'; # spent 75µs making 1 call to base::import, max recursion depth 1 |
| 14 | ||||
| 15 | 45 | 97µs | 2µs | sub _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 | |||
| 18 | 32 | 207µs | 6µ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 | ||||
| 24 | 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 | |||
| 33 | 302 | 2.05ms | 7µ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 | ||||
| 112 | 1 | 4µs | 4µs | 1; |
| 113 | ||||
| 114 | __END__ | |||
| 115 | ||||
| 116 | =pod | |||
| 117 | ||||
| 118 | =head1 NAME | |||
| 119 | ||||
| 120 | Class::MOP::Method::Inlined - Method base class for methods which have been inlined | |||
| 121 | ||||
| 122 | =head1 DESCRIPTION | |||
| 123 | ||||
| 124 | This is a L<Class::MOP::Method::Generated> subclass for methods which | |||
| 125 | can be inlined. | |||
| 126 | ||||
| 127 | =head1 METHODS | |||
| 128 | ||||
| 129 | =over 4 | |||
| 130 | ||||
| 131 | =item B<< $metamethod->can_be_inlined >> | |||
| 132 | ||||
| 133 | This method returns true if the method in question can be inlined in | |||
| 134 | the associated metaclass. | |||
| 135 | ||||
| 136 | If it cannot be inlined, it spits out a warning and returns false. | |||
| 137 | ||||
| 138 | =back | |||
| 139 | ||||
| 140 | =head1 AUTHORS | |||
| 141 | ||||
| 142 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
| 143 | ||||
| 144 | =head1 COPYRIGHT AND LICENSE | |||
| 145 | ||||
| 146 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
| 147 | ||||
| 148 | L<http://www.iinteractive.com> | |||
| 149 | ||||
| 150 | This library is free software; you can redistribute it and/or modify | |||
| 151 | it under the same terms as Perl itself. | |||
| 152 | ||||
| 153 | =cut | |||
| 154 |