foo

[gitmo/Class-MOP.git] / t / 018_anon_class.t

diff --git a/t/018_anon_class.t b/t/018_anon_class.t
index 6534662..1eb3aa6 100644 (file)
--- a/t/018_anon_class.t
+++ b/t/018_anon_class.t
@@ -3,26 +3,79 @@
 use strict;
 use warnings;
 
-use Test::More tests => 7;
+use Test::More tests => 24;
 use Test::Exception;
 
 BEGIN {
     use_ok('Class::MOP');
 }
 
-my $anon_class = Class::MOP::Class->create_anon_class();
-isa_ok($anon_class, 'Class::MOP::Class');
+{
+    package Foo;
+    use strict;
+    use warnings;
+    use metaclass;
+    
+    sub bar { 'Foo::bar' }
+}
+
+my $anon_class_id;
+my $instance;
+{
+    my $anon_class = Class::MOP::Class->create_anon_class();
+    isa_ok($anon_class, 'Class::MOP::Class');
+    
+    ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/);
+    
+    ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists');
+    like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name');
+
+    is_deeply(
+        [$anon_class->superclasses],
+        [],
+        '... got an empty superclass list');
+    lives_ok {
+        $anon_class->superclasses('Foo');
+    } '... can add a superclass to anon class';
+    is_deeply(
+        [$anon_class->superclasses],
+        [ 'Foo' ],
+        '... got the right superclass list');
 
-like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name');
+    ok(!$anon_class->has_method('foo'), '... no foo method');
+    lives_ok {
+        $anon_class->add_method('foo' => sub { "__ANON__::foo" });
+    } '... added a method to my anon-class';
+    ok($anon_class->has_method('foo'), '... we have a foo method now');  
 
-lives_ok {
-    $anon_class->add_method('foo' => sub { "__ANON__::foo" });
-} '... added a method to my anon-class';
+    $instance = $anon_class->new_object();
+    isa_ok($instance, $anon_class->name);
+    isa_ok($instance, 'Foo');    
+
+    is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
+    is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');    
+}
 
-my $instance = $anon_class->new_object();
-isa_ok($instance, $anon_class->name);
+ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists');
+
+# the superclass relationship actually 
+# still exists for the instance ...
+isa_ok($instance, 'Foo');
+
+# and oddly enough we can still 
+# call methods on our instance
+can_ok($instance, 'foo');
+can_ok($instance, 'bar');
 
 is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
+is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');
+
+# but it breaks down when we try to create another one ...
+
+my $instance_2 = bless {} => ref($instance);
+isa_ok($instance_2, ref($instance));
+ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo');
+ok(!$instance_2->can('foo'), '... and it can no longer call the foo method');
 
 # NOTE:
 # I bumped this test up to 100_000 instances, and 
@@ -30,8 +83,8 @@ is($instance->foo, '__ANON__::foo', '... got the right return value of our foo m
 # more than that, your probably mst
 
 my %conflicts;
-foreach my $i (1 .. 1000) {
+foreach my $i (1 .. 100) {
     $conflicts{ Class::MOP::Class->create_anon_class()->name } = undef;
 }
-is(scalar(keys %conflicts), 1000, '... got as many classes as I would expect');
+is(scalar(keys %conflicts), 100, '... got as many classes as I would expect');