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 {
my ($class, %options) = @_;
my $cache_ok = delete $options{cache};
+ $options{weaken} = !$cache_ok unless exists $options{weaken};
my $cache_key;
if ($cache_ok) {
}
}
- $options{weaken} = !$cache_ok unless exists $options{weaken};
-
my $package_name = $class->_anon_package_prefix . ++$ANON_SERIAL;
my $meta = $class->create($package_name, %options);
# 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 . '::'};
# 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 {