From: Fuji, Goro <gfuji@cpan.org>
Date: Thu, 28 Oct 2010 12:47:16 +0000 (+0900)
Subject: Fix a problem; roles with bare-attributes could affect cache invalidation
X-Git-Tag: 0.81~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6f09819f35c5d66d8de41a6d8aa1cd1395815397;p=gitmo%2FMouse.git

Fix a problem; roles with bare-attributes could affect cache invalidation
---

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 14a8762..20b2181 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -241,7 +241,7 @@ sub add_attribute {
     # then register the attribute to the metaclass
     $attr->{insertion_order}   = keys %{ $self->{attributes} };
     $self->{attributes}{$name} = $attr;
-    delete $self->{_mouse_cache}; # clears internal cache
+    $self->_invalidate_metaclass_cache();
 
     if(!$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){
         Carp::carp(qq{Attribute ($name) of class }.$self->name
diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index dfee591..c0ec9a6 100644
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -339,6 +339,12 @@ sub is_immutable {  $_[0]->{is_immutable} }
 sub strict_constructor;
 *strict_constructor = $generate_class_accessor->('strict_constructor');
 
+sub _invalidate_metaclass_cache {
+    my($self) = @_;
+    delete $self->{_mouse_cache};
+    return;
+}
+
 sub _report_unknown_args {
     my($metaclass, $attrs, $args) = @_;
 
diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 32ab97c..eff6ab7 100644
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -624,6 +624,19 @@ CODE:
     mouse_class_initialize_object(aTHX_ meta, object, args, is_cloning);
 }
 
+void
+_invalidate_metaclass_cache(SV* meta)
+CODE:
+{
+    AV* const xc = mouse_get_xc_if_fresh(aTHX_ meta);
+    if(xc) {
+        SV* const gen = MOUSE_xc_gen(xc);
+        sv_setuv(gen, 0U);
+    }
+    delete_slot(meta, newSVpvs_flags("_mouse_cache_", SVs_TEMP));
+}
+
+
 MODULE = Mouse  PACKAGE = Mouse::Meta::Role
 
 BOOT: