From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sat, 9 Aug 2008 05:18:18 +0000 (+0000)
Subject: correct invalidation of meta instance
X-Git-Tag: 0_64_01~63
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=caab0eaaa67d626df9e0113822d95fcfa0968022;p=gitmo%2FClass-MOP.git

correct invalidation of meta instance
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index b8834a6..d994d20 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -383,20 +383,6 @@ sub construct_instance {
 
 sub get_meta_instance {
     my $self = shift;
-    # NOTE:
-    # just about any fiddling with @ISA or 
-    # any fiddling with attributes will 
-    # also fiddle with the symbol table 
-    # and therefore invalidate the package 
-    # cache, in which case we should blow 
-    # away the meta-instance cache. Of course
-    # this will invalidate it more often then 
-    # is probably needed, but better safe 
-    # then sorry.
-    # - SL
-    $self->{'_meta_instance'} = undef
-        if defined $self->{'_package_cache_flag'} && 
-                   $self->{'_package_cache_flag'} == Class::MOP::check_package_cache_flag($self->name);
     $self->{'_meta_instance'} ||= $self->instance_metaclass->new(
         associated_metaclass => $self,
         attributes => [ $self->compute_all_applicable_attributes() ],
@@ -835,12 +821,32 @@ sub add_attribute {
     # name here so that we can properly detach
     # the old attr object, and remove any
     # accessors it would have generated
-    $self->remove_attribute($attribute->name)
-        if $self->has_attribute($attribute->name);
+    if ( $self->has_attribute($attribute->name) ) {
+        $self->remove_attribute($attribute->name);
+    } else {
+        $self->invalidate_meta_instances();
+    }
 
     # then onto installing the new accessors
-    $attribute->install_accessors();
     $self->get_attribute_map->{$attribute->name} = $attribute;
+
+    # invalidate package flag here
+    $attribute->install_accessors();
+
+    return $attribute;
+}
+
+sub invalidate_meta_instances {
+    my $self = shift;
+    
+    my @metas = ( $self, map { Class::MOP::Class->initialize($_) } $self->subclasses );
+
+    $_->invalidate_meta_instance() for @metas;
+}
+
+sub invalidate_meta_instance {
+    my $self = shift;
+    undef $self->{_meta_instance};
 }
 
 sub has_attribute {
@@ -868,6 +874,7 @@ sub remove_attribute {
     my $removed_attribute = $self->get_attribute_map->{$attribute_name};
     return unless defined $removed_attribute;
     delete $self->get_attribute_map->{$attribute_name};
+    $self->invalidate_meta_instances();
     $removed_attribute->remove_accessors();
     $removed_attribute->detach_from_class();
     return $removed_attribute;
@@ -1166,6 +1173,17 @@ but in some cases you might want to use it, so it is here.
 Clears the package cache flag to announce to the internals that we need 
 to rebuild the method map.
 
+=item B<invalidate_meta_instances>
+
+Clears the cached meta instance for this metaclass and all of its subclasses.
+
+Called by C<add_attribute> and C<remove_attribute> to recalculate the attribute
+slots.
+
+=item B<invalidate_meta_instance>
+
+Used by C<invalidate_meta_instances>.
+
 =back
 
 =head2 Object instance construction and cloning
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index 406cf72..7e63a8e 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 204;
+use Test::More tests => 208;
 use Test::Exception;
 
 BEGIN {
@@ -60,6 +60,8 @@ my @class_mop_class_methods = qw(
     rebless_instance
     check_metaclass_compatability
 
+    invalidate_meta_instances invalidate_meta_instance
+
     attribute_metaclass method_metaclass
 
     superclasses subclasses class_precedence_list linearized_isa
diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t
index a29f00c..e96ef11 100644
--- a/t/102_InsideOutClass_test.t
+++ b/t/102_InsideOutClass_test.t
@@ -40,6 +40,10 @@ BEGIN {
     }
     
     package Bar;
+    use metaclass (
+        'attribute_metaclass' => 'InsideOutClass::Attribute',
+        'instance_metaclass'  => 'InsideOutClass::Instance'
+    );
     
     use strict;
     use warnings;
@@ -66,6 +70,10 @@ BEGIN {
     ));     
     
     package Bar::Baz;
+    use metaclass (
+        'attribute_metaclass' => 'InsideOutClass::Attribute',
+        'instance_metaclass'  => 'InsideOutClass::Instance'
+    );
     
     use strict;
     use warnings;
@@ -214,4 +222,4 @@ is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
     is(scalar(keys(%{'Bar::Baz::bar'})), 0, '... got the right number of entries for Bar::Baz::bar');
     is(scalar(keys(%{'Bar::Baz::baz'})), 0, '... got the right number of entries for Bar::Baz::baz');    
     is(scalar(keys(%{'Bar::Baz::bling'})), 0, '... got the right number of entries for Bar::Baz::bling');        
-}
\ No newline at end of file
+}
diff --git a/t/108_ArrayBasedStorage_test.t b/t/108_ArrayBasedStorage_test.t
index efedf25..a2dc99c 100644
--- a/t/108_ArrayBasedStorage_test.t
+++ b/t/108_ArrayBasedStorage_test.t
@@ -39,6 +39,9 @@ BEGIN {
     }
 
     package Bar;
+    use metaclass (
+        'instance_metaclass'  => 'ArrayBasedStorage::Instance',
+    );
 
     use strict;
     use warnings;
@@ -51,6 +54,9 @@ BEGIN {
     ));
 
     package Baz;
+    use metaclass (
+        'instance_metaclass'  => 'ArrayBasedStorage::Instance',
+    );
 
     use strict;
     use warnings;
@@ -64,6 +70,9 @@ BEGIN {
     ));
 
     package Bar::Baz;
+    use metaclass (
+        'instance_metaclass'  => 'ArrayBasedStorage::Instance',
+    );
 
     use strict;
     use warnings;