We need to be smarter about recalculation of __cag_supers within inherited, as @ISA...
Peter Rabbitson [Thu, 19 Mar 2009 21:28:17 +0000 (21:28 +0000)]
lib/Class/Accessor/Grouped.pm
t/inherited.t
t/lib/ExtraInheritedGroups.pm [new file with mode: 0644]

index bdba1a8..b983975 100644 (file)
@@ -303,8 +303,11 @@ sub get_inherited {
     no strict 'refs';
     return ${$class.'::__cag_'.$_[1]} if defined(${$class.'::__cag_'.$_[1]});
 
-    if (!@{$class.'::__cag_supers'}) {
+    # we need to be smarter about recalculation, as @ISA (thus supers) can very well change in-flight
+    my $pkg_gen = mro::get_pkg_gen ($class);
+    if (!@{$class.'::__cag_supers'} or ${$class.'::__cag_pkg_gen'} != $pkg_gen ) {
         @{$class.'::__cag_supers'} = $_[0]->get_super_paths;
+        ${$class.'::__cag_pkg_gen'} = $pkg_gen;
     };
 
     foreach (@{$class.'::__cag_supers'}) {
index 80ef240..942c309 100644 (file)
@@ -1,4 +1,4 @@
-use Test::More tests => 35;
+use Test::More tests => 36;
 use strict;
 use warnings;
 use lib 't/lib';
@@ -81,3 +81,14 @@ SuperInheritedGroups->basefield(undef);
 is(SuperInheritedGroups->basefield, 'base');
 
 is(BaseInheritedGroups->undefined, undef);
+
+# make sure run-time @ISA changes trigger an inheritance chain recalculation
+SuperInheritedGroups->basefield(undef);
+BaseInheritedGroups->basefield('your base');
+
+# dirty hack, emulate Class::C3::Componentised
+require ExtraInheritedGroups;
+unshift @SuperInheritedGroups::ISA, qw/ExtraInheritedGroups/;
+
+# this comes from ExtraInheritedGroups
+is(SuperInheritedGroups->basefield, 'your extra base!');
diff --git a/t/lib/ExtraInheritedGroups.pm b/t/lib/ExtraInheritedGroups.pm
new file mode 100644 (file)
index 0000000..6b76853
--- /dev/null
@@ -0,0 +1,9 @@
+package ExtraInheritedGroups;
+use strict;
+use warnings;
+use base 'Class::Accessor::Grouped';
+
+__PACKAGE__->mk_group_accessors('inherited', 'basefield');
+__PACKAGE__->set_inherited (basefield => 'your extra base!');
+
+1;