From: Jesse Luehrs Date: Mon, 10 May 2010 17:58:53 +0000 (-0500) Subject: handle undef metaclasses where they are defined in superclass X-Git-Tag: 1.02~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=06ea51c77e19bd6d13206e4a5423cf5cd5108267;p=gitmo%2FClass-MOP.git handle undef metaclasses where they are defined in superclass --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 8a80a89..99e8c97 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -257,8 +257,10 @@ sub _single_metaclass_is_compatible { return 1 unless $super_meta->can($metaclass_type); # for instance, Moose::Meta::Class has a destructor_class, but # Class::MOP::Class doesn't - this shouldn't be an error - return 1 if defined $self->$metaclass_type - && !defined $super_meta->$metaclass_type; + return 1 unless defined $super_meta->$metaclass_type; + # if metaclass is defined in superclass but not here, it's not compatible + # this is a really odd case + return 0 unless defined $self->$metaclass_type; return $self->$metaclass_type->isa($super_meta->$metaclass_type); } @@ -301,8 +303,11 @@ sub _can_fix_single_metaclass_incompatibility_by_subclassing { # for instance, Moose::Meta::Class has a destructor_class, but # Class::MOP::Class doesn't - this shouldn't be an error - return if defined $specific_meta - && !defined $super_specific_meta; + return unless defined $super_specific_meta; + + # if metaclass is defined in superclass but not here, it's fixable + # this is a really odd case + return 1 unless defined $specific_meta; return $specific_meta ne $super_specific_meta && $super_specific_meta->isa($specific_meta); @@ -316,7 +321,6 @@ sub _can_fix_metaclass_incompatibility_by_subclassing { my %base_metaclass = $self->_base_metaclasses; for my $metaclass_type (keys %base_metaclass) { - next unless defined $self->$metaclass_type; return 1 if $self->_can_fix_single_metaclass_incompatibility_by_subclassing($metaclass_type, $super_meta); } @@ -347,7 +351,6 @@ sub _fix_metaclass_incompatibility { my %base_metaclass = $self->_base_metaclasses; for my $metaclass_type (keys %base_metaclass) { - next unless defined $self->$metaclass_type; for my $super (@supers) { if (!$self->_single_metaclass_is_compatible($metaclass_type, $super->name)) { $self->_fix_single_metaclass_incompatibility( diff --git a/t/041_metaclass_incompatibility.t b/t/041_metaclass_incompatibility.t index 5c24305..c73b01e 100644 --- a/t/041_metaclass_incompatibility.t +++ b/t/041_metaclass_incompatibility.t @@ -214,4 +214,43 @@ isa_ok(Class::MOP::class_of('Foo::Reverse::Sub::Sub'), 'Foo::Meta::Class'); lives_ok { $bazmeta->make_immutable } "can still make immutable"; } +# nonexistent metaclasses + +Class::MOP::Class->create('Weird::Meta::Method::Destructor'); + +lives_ok { + Class::MOP::Class->create( + 'Weird::Class', + destructor_class => 'Weird::Meta::Method::Destructor', + ); +} "defined metaclass in child with defined metaclass in parent is fine"; + +is(Weird::Class->meta->destructor_class, 'Weird::Meta::Method::Destructor', + "got the right destructor class"); + +lives_ok { + Class::MOP::Class->create( + 'Weird::Class::Sub', + superclasses => ['Weird::Class'], + destructor_class => undef, + ); +} "undef metaclass in child with defined metaclass in parent can be fixed"; + +is(Weird::Class::Sub->meta->destructor_class, 'Weird::Meta::Method::Destructor', + "got the right destructor class"); + +lives_ok { + Class::MOP::Class->create( + 'Weird::Class::Sub2', + destructor_class => undef, + ); +} "undef metaclass in child with defined metaclass in parent can be fixed"; + +lives_ok { + Weird::Class::Sub2->meta->superclasses('Weird::Class'); +} "undef metaclass in child with defined metaclass in parent can be fixed"; + +is(Weird::Class::Sub->meta->destructor_class, 'Weird::Meta::Method::Destructor', + "got the right destructor class"); + done_testing;