this-is-wrong

diff --git a/Changes b/Changes
index 7831c7e..8847997 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,6 @@
 Revision history for Perl extension Class-MOP.
 
-0.30 Sat. May 6, 2006
+0.30 Mon. May 8, 2006
     * Class::MOP::Class
       - anon-classes are now properly garbage collected
         - added tests for this 

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 6036e45..9e06a4b 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -664,50 +664,63 @@ our $VERSION = '0.01';
 
 use base 'Class::MOP::Class';
     
-{
-    # NOTE:
-    # we hold a weakened cache here
-    my %ANON_METAS;    
-    
-    # NOTE:
-    # this should be sufficient, if you have a 
-    # use case where it is not, write a test and 
-    # I will change it.
-    my $ANON_CLASS_SERIAL = 0;
-
-    sub create {
-        my ($class, %options) = @_;   
-        my $package_name = __PACKAGE__ . '::SERIAL::' . ++$ANON_CLASS_SERIAL;
-        return $class->SUPER::create($package_name, '0.00', %options);
-    }
+# we hold a weakened cache here
+my %ANON_METAS;    
 
-    sub construct_class_instance {
-        my ($class, %options) = @_;
-        my $package_name = $options{':package'};
+# NOTE:
+# this should be sufficient, if you have a 
+# use case where it is not, write a test and 
+# I will change it.
+my $ANON_CLASS_SERIAL = 0;
+
+# prefix for all anon-class names
+my $ANON_CLASS_PREFIX = __PACKAGE__ . '::SERIAL::';
+
+sub initialize {
+    my $class = shift;
+    if ($_[0] =~ /^$ANON_CLASS_PREFIX/) {
+        $class->SUPER::initialize(@_);            
+    }
+    else {
         # NOTE:
-        # we cache the anon metaclasses as well
-        # but we weaken them (see below)
-        return $ANON_METAS{$package_name} 
-            if exists  $ANON_METAS{$package_name} && 
-               defined $ANON_METAS{$package_name};            
-        my $meta = $class->meta->construct_instance(%options);
-        $meta->check_metaclass_compatability();
-        # weaken the metaclass cache so that 
-        # DESTROY gets called as expected
-        weaken($ANON_METAS{$package_name} = $meta);
-        return $meta;
+        # we need to do this or weird
+        # things happen 
+        Class::MOP::Class->initialize(@_);
     }
 }
 
+sub create {
+    my ($class, %options) = @_;   
+    my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
+    return $class->SUPER::create($package_name, '0.00', %options);
+}
+
+sub construct_class_instance {
+    my ($class, %options) = @_;
+    my $package_name = $options{':package'};
+    # NOTE:
+    # we cache the anon metaclasses as well
+    # but we weaken them (see below)
+    return $ANON_METAS{$package_name} 
+        if exists  $ANON_METAS{$package_name} && 
+           defined $ANON_METAS{$package_name};            
+    my $meta = $class->meta->construct_instance(%options);
+    $meta->check_metaclass_compatability();
+    # weaken the metaclass cache so that 
+    # DESTROY gets called as expected
+    weaken($ANON_METAS{$package_name} = $meta);
+    return $meta;
+}
+
 sub DESTROY {
     my $self = shift;
-    my $prefix = __PACKAGE__ . '::SERIAL::';
-    my ($serial_id) = ($self->name =~ /$prefix(\d+)/);
+    my ($serial_id) = ($self->name =~ /$ANON_CLASS_PREFIX(\d+)/);
+    #warn "destroying $prefix => $serial_id\n$self => ". $self->name;    
     no strict 'refs';
-    foreach my $key (keys %{$prefix . $serial_id}) {
-        delete ${$prefix . $serial_id}{$key};
+    foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
+        delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
     }
-    delete ${'main::' . $prefix}{$serial_id . '::'};
+    delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
 }
 
 1;

diff --git a/t/018_anon_class.t b/t/018_anon_class.t
index 25e55ef..d8d43fe 100644 (file)
--- a/t/018_anon_class.t
+++ b/t/018_anon_class.t
@@ -3,13 +3,22 @@
 use strict;
 use warnings;
 
-use Test::More tests => 9;
+use Test::More tests => 16;
 use Test::Exception;
 
 BEGIN {
     use_ok('Class::MOP');
 }
 
+{
+    package Foo;
+    use strict;
+    use warnings;
+    use metaclass;
+    
+    sub bar { 'Foo::bar' }
+}
+
 my $anon_class_id;
 {
     my $anon_class = Class::MOP::Class->create_anon_class();
@@ -18,17 +27,32 @@ my $anon_class_id;
     ($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');
+
+    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');
 
     my $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');    
 }
 
 ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists');
@@ -39,8 +63,8 @@ ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'},
 # 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');