handle undef metaclasses where they are defined in superclass

nothingmuch · May 12, 2010 · 06ea51c · 06ea51c
1 parent db1d879
commit 06ea51c
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 6 deletions.
diff --git 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
@@ -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;