X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FInlined.pm;h=8d28aeb0dca1a470f3b90448f7a1da699b25dc73;hb=81b5e774319e5a9b83f09aae1b101b25ff7af350;hp=e7fb0130d0ca299af47e79b2d1e05396f0f0d5ce;hpb=a828455d79d02cb9e825aff57ac81d18dca0e660;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Inlined.pm b/lib/Class/MOP/Method/Inlined.pm index e7fb013..8d28aeb 100644 --- a/lib/Class/MOP/Method/Inlined.pm +++ b/lib/Class/MOP/Method/Inlined.pm @@ -6,7 +6,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr'; -our $VERSION = '0.82_01'; +our $VERSION = '1.09'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -34,77 +34,79 @@ sub can_be_inlined { my $metaclass = $self->associated_metaclass; my $class = $metaclass->name; + # If we don't find an inherited method, this is a rather weird + # case where we have no method in the inheritance chain even + # though we're expecting one to be there + my $inherited_method + = $metaclass->find_next_method_by_name( $self->name ); + + if ( $inherited_method + && $inherited_method->isa('Class::MOP::Method::Wrapped') ) { + warn "Not inlining '" + . $self->name + . "' for $class since it " + . "has method modifiers which would be lost if it were inlined\n"; + + return 0; + } + my $expected_class = $self->_expected_method_class or return 1; # if we are shadowing a method we first verify that it is # compatible with the definition we are replacing it with - if ( my $expected_method = $expected_class->can( $self->name ) ) { - - my $actual_method = $class->can( $self->name ) - or return 1; - - # the method is what we wanted (probably Moose::Object::new) - return 1 - if refaddr($expected_method) == refaddr($actual_method); - - # If we don't find an inherited method, this is a rather weird - # case where we have no method in the inheritance chain even - # though we're expecting one to be there - # - # this returns 1 for backwards compatibility for now - my $inherited_method - = $metaclass->find_next_method_by_name( $self->name ) - or return 1; - - # otherwise we have to check that the actual method is an inlined - # version of what we're expecting - if ( $inherited_method->isa(__PACKAGE__) ) { - if ( refaddr( $inherited_method->_uninlined_body ) - == refaddr($expected_method) ) { - return 1; - } - } - elsif ( refaddr( $inherited_method->body ) - == refaddr($expected_method) ) { - return 1; - } + my $expected_method = $expected_class->can( $self->name ); - my $warning - = "Not inlining '" + if ( ! $expected_method ) { + warn "Not inlining '" . $self->name - . "' for $class since it is not" - . " inheriting the default ${expected_class}::" - . $self->name . "\n"; + . "' for $class since ${expected_class}::" + . $self->name + . " is not defined\n"; - if ( $self->isa("Class::MOP::Method::Constructor") ) { + return 0; + } + + my $actual_method = $class->can( $self->name ) + or return 1; - # FIXME kludge, refactor warning generation to a method - $warning - .= "If you are certain you don't need to inline your" - . " constructor, specify inline_constructor => 0 in your" - . " call to $class->meta->make_immutable\n"; + # the method is what we wanted (probably Moose::Object::new) + return 1 + if refaddr($expected_method) == refaddr($actual_method); + + # otherwise we have to check that the actual method is an inlined + # version of what we're expecting + if ( $inherited_method->isa(__PACKAGE__) ) { + if ( $inherited_method->_uninlined_body + && refaddr( $inherited_method->_uninlined_body ) + == refaddr($expected_method) ) { + return 1; } + } + elsif ( refaddr( $inherited_method->body ) + == refaddr($expected_method) ) { + return 1; + } - $warning - .= " ('" - . $self->name - . "' has method modifiers which would be lost if it were inlined)\n" - if $inherited_method->isa('Class::MOP::Method::Wrapped'); + my $warning + = "Not inlining '" + . $self->name + . "' for $class since it is not" + . " inheriting the default ${expected_class}::" + . $self->name . "\n"; - warn $warning; + if ( $self->isa("Class::MOP::Method::Constructor") ) { - return 0; + # FIXME kludge, refactor warning generation to a method + $warning + .= "If you are certain you don't need to inline your" + . " constructor, specify inline_constructor => 0 in your" + . " call to $class->meta->make_immutable\n"; } - else { - warn "Not inlining '" - . $self->name - . "' for $class since ${expected_class}::" - . $self->name - . " is not defined\n"; - return 0; - } + warn $warning; + + return 0; } 1; @@ -141,7 +143,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L