X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FPackage.pm;h=ad2202c8c6e4fd32091fc7163413f3dd84c74b52;hb=b4567caf469e38cef213b811061646ac62fcd4fc;hp=062706fb32fb68e2e54e77f360033f8908f7626b;hpb=85db9063790a152f0b6f4a29cb9dc0955acaffcd;p=gitmo%2FMoose.git

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 062706f..ad2202c 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -22,8 +22,7 @@ sub initialize {
     my $package_name = delete $options{package};
 
 
-    # we hand-construct the class 
-    # until we can bootstrap it
+    # we hand-construct the class until we can bootstrap it
     if ( my $meta = Class::MOP::get_metaclass_by_name($package_name) ) {
         return $meta;
     } else {
@@ -141,14 +140,24 @@ 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 =~ /^(.*)::(.*)$/);
 
         no strict 'refs';
+        # clear @ISA first, to avoid a memory leak
+        # see https://rt.perl.org/rt3/Public/Bug/Display.html?id=92708
         @{$name . '::ISA'} = ();
         %{$name . '::'}    = ();
         delete ${$first_fragments . '::'}{$last_fragment . '::'};
@@ -187,7 +196,7 @@ sub _new {
 # Attributes
 
 # NOTE:
-# all these attribute readers will be bootstrapped 
+# all these attribute readers will be bootstrapped
 # away in the Class::MOP bootstrap section
 
 sub _package_stash {