make sure to clear the stash when anon classes are removed explicitly

diff --git a/Changes b/Changes
index 9096875..cbaa4fc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -64,6 +64,9 @@ for, noteworthy changes.
     class that the class type represents when the class type wasn't registered.
     (doy)
 
+  * Removing anonymous metaclasses prematurely no longer prevents reaping of
+    the associated stash. (doy)
+
   [OTHER]
 
   * The Class::MOP::load_class and Class::MOP::is_class_loaded subroutines are

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index a7b75bf..079d28a 100644 (file)
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -140,10 +140,18 @@ sub create {
         # class when fixing metaclass incompatibility. In that case,
         # we don't want to clean out the namespace now. We can detect
         # that because Moose will explicitly update the singleton
-        # cache in Class::MOP.
-        no warnings 'uninitialized';
+        # cache in Class::MOP using store_metaclass_by_name, which
+        # means that the new metaclass will already exist in the cache
+        # by this point.
+        # The other options here are that $current_meta can be undef if
+        # remove_metaclass_by_name is called explicitly (since the hash
+        # entry is removed first, and then this destructor is called),
+        # or that $current_meta can be the same as $self, which happens
+        # when the metaclass goes out of scope (since the weak reference
+        # in the metaclass cache won't be freed until after this
+        # destructor runs).
         my $current_meta = Class::MOP::get_metaclass_by_name($name);
-        return if $current_meta ne $self;
+        return if defined($current_meta) && $current_meta ne $self;
 
         my ($first_fragments, $last_fragment) = ($name =~ /^(.*)::(.*)$/);
 

diff --git a/t/cmop/anon_class_removal.t b/t/cmop/anon_class_removal.t
new file mode 100644 (file)
index 0000000..cb03370
--- /dev/null
+++ b/t/cmop/anon_class_removal.t
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Class::MOP;
+
+{
+    my $class;
+    {
+        my $meta = Class::MOP::Class->create_anon_class(
+            methods => {
+                foo => sub { 'FOO' },
+            },
+        );
+
+        $class = $meta->name;
+        can_ok($class, 'foo');
+        is($class->foo, 'FOO');
+    }
+    ok(!$class->can('foo'));
+}
+
+{
+    my $class;
+    {
+        my $meta = Class::MOP::Class->create_anon_class(
+            methods => {
+                foo => sub { 'FOO' },
+            },
+        );
+
+        $class = $meta->name;
+        can_ok($class, 'foo');
+        is($class->foo, 'FOO');
+        Class::MOP::remove_metaclass_by_name($class);
+    }
+    ok(!$class->can('foo'));
+}
+
+done_testing;

diff --git a/t/roles/anonymous_roles.t b/t/roles/anonymous_roles.t
index 549ab85..5ce41ec 100644 (file)
--- a/t/roles/anonymous_roles.t
+++ b/t/roles/anonymous_roles.t
@@ -35,4 +35,35 @@ ok($role->is_anon_role, "the role knows it's anonymous");
 ok(is_class_loaded(Moose::Meta::Role->create_anon_role->name), "creating an anonymous role satisifes is_class_loaded");
 ok(Class::MOP::class_of(Moose::Meta::Role->create_anon_role->name), "creating an anonymous role satisifes class_of");
 
+{
+    my $role;
+    {
+        my $meta = Moose::Meta::Role->create_anon_role(
+            methods => {
+                foo => sub { 'FOO' },
+            },
+        );
+
+        $role = $meta->name;
+        can_ok($role, 'foo');
+    }
+    ok(!$role->can('foo'));
+}
+
+{
+    my $role;
+    {
+        my $meta = Moose::Meta::Role->create_anon_role(
+            methods => {
+                foo => sub { 'FOO' },
+            },
+        );
+
+        $role = $meta->name;
+        can_ok($role, 'foo');
+        Class::MOP::remove_metaclass_by_name($role);
+    }
+    ok(!$role->can('foo'));
+}
+
 done_testing;