[Bast-commits] r5781 - in trunk/Class-Accessor-Grouped: lib/Class/Accessor t t/lib

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-03-19 21:28:17 +0000 (Thu, 19 Mar 2009)
New Revision: 5781

Added:
   trunk/Class-Accessor-Grouped/t/lib/ExtraInheritedGroups.pm
Modified:
   trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
   trunk/Class-Accessor-Grouped/t/inherited.t
Log:
We need to be smarter about recalculation of __cag_supers within inherited, as @ISA (thus supers) can very well change in-flight

Modified: trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
===================================================================
--- trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2009-03-19 21:18:02 UTC (rev 5780)
+++ trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2009-03-19 21:28:17 UTC (rev 5781)
@@ -303,8 +303,11 @@
     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'}) {

Modified: trunk/Class-Accessor-Grouped/t/inherited.t
===================================================================
--- trunk/Class-Accessor-Grouped/t/inherited.t	2009-03-19 21:18:02 UTC (rev 5780)
+++ trunk/Class-Accessor-Grouped/t/inherited.t	2009-03-19 21:28:17 UTC (rev 5781)
@@ -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 @@
 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!');

Added: trunk/Class-Accessor-Grouped/t/lib/ExtraInheritedGroups.pm
===================================================================
--- trunk/Class-Accessor-Grouped/t/lib/ExtraInheritedGroups.pm	                        (rev 0)
+++ trunk/Class-Accessor-Grouped/t/lib/ExtraInheritedGroups.pm	2009-03-19 21:28:17 UTC (rev 5781)
@@ -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;