Revert "convert all uses of Test::Exception to Test::Fatal."

[gitmo/Class-MOP.git] / t / 041_metaclass_incompatibility.t

diff --git a/t/041_metaclass_incompatibility.t b/t/041_metaclass_incompatibility.t
index ac16bc1..5b0223f 100644 (file)
--- a/t/041_metaclass_incompatibility.t
+++ b/t/041_metaclass_incompatibility.t
@@ -172,7 +172,7 @@ Foo::Meta::Class->create(
     'Foo::Reverse',
 );
 isa_ok(Class::MOP::class_of('Foo::Reverse'), 'Foo::Meta::Class');
-{ local $TODO = "no idea how to handle this";
+{ local $TODO = 'No idea how to handle case where parent class is created before children';
 isa_ok(Class::MOP::class_of('Foo::Reverse::Sub'), 'Foo::Meta::Class');
 isa_ok(Class::MOP::class_of('Foo::Reverse::Sub::Sub'), 'Foo::Meta::Class');
 }
@@ -193,4 +193,67 @@ isa_ok(Class::MOP::class_of('Foo::Reverse::Sub::Sub'), 'Foo::Meta::Class');
               "can't switch out the attribute metaclass of a class that already has attributes";
 }
 
+# immutability...
+
+{
+    my $foometa = Foo::Meta::Class->create(
+        'Foo::Immutable',
+    );
+    $foometa->make_immutable;
+    my $barmeta = Class::MOP::Class->create(
+        'Bar::Mutable',
+    );
+    my $bazmeta = Class::MOP::Class->create(
+        'Baz::Mutable',
+    );
+    $bazmeta->superclasses($foometa->name);
+    lives_ok { $bazmeta->superclasses($barmeta->name) }
+             "can still set superclasses";
+    ok(!$bazmeta->is_immutable,
+       "immutable superclass doesn't make this class immutable");
+    lives_ok { $bazmeta->make_immutable } "can still make immutable";
+}
+
+# nonexistent metaclasses
+
+Class::MOP::Class->create(
+    'Weird::Meta::Method::Destructor',
+    superclasses => ['Class::MOP::Method'],
+);
+
+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;