From: Dave Rolsky Date: Fri, 24 Apr 2009 14:21:40 +0000 (-0500) Subject: Refactor to exit early if we cannot inline X-Git-Tag: 0.82_02~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=71e9cdebdf3152592b0d75cef3217f90de84be8e;p=gitmo%2FClass-MOP.git Refactor to exit early if we cannot inline --- diff --git a/lib/Class/MOP/Method/Inlined.pm b/lib/Class/MOP/Method/Inlined.pm index e7fb013..db4f8ea 100644 --- a/lib/Class/MOP/Method/Inlined.pm +++ b/lib/Class/MOP/Method/Inlined.pm @@ -39,72 +39,72 @@ sub can_be_inlined { # 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 $expected_method = $expected_class->can( $self->name ); - my $actual_method = $class->can( $self->name ) + if ( ! $expected_method ) { + warn "Not inlining '" + . $self->name + . "' for $class since ${expected_class}::" + . $self->name + . " is not defined\n"; + + return 0; + } + + 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; - # 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) ) { + # 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 $warning - = "Not inlining '" - . $self->name - . "' for $class since it is not" - . " inheriting the default ${expected_class}::" - . $self->name . "\n"; - - if ( $self->isa("Class::MOP::Method::Constructor") ) { + my $warning + = "Not inlining '" + . $self->name + . "' for $class since it is not" + . " inheriting the default ${expected_class}::" + . $self->name . "\n"; - # 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"; - } + if ( $self->isa("Class::MOP::Method::Constructor") ) { + # FIXME kludge, refactor warning generation to a method $warning - .= " ('" - . $self->name - . "' has method modifiers which would be lost if it were inlined)\n" - if $inherited_method->isa('Class::MOP::Method::Wrapped'); + .= "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"; + } - warn $warning; + $warning + .= " ('" + . $self->name + . "' has method modifiers which would be lost if it were inlined)\n" + if $inherited_method->isa('Class::MOP::Method::Wrapped'); - return 0; - } - else { - warn "Not inlining '" - . $self->name - . "' for $class since ${expected_class}::" - . $self->name - . " is not defined\n"; + warn $warning; - return 0; - } + return 0; } 1;