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

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2010-10-08 17:13:39 +0100 (Fri, 08 Oct 2010)
New Revision: 9748

Added:
   Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsSubclass.pm
Modified:
   Class-Accessor-Grouped/trunk/t/accessors.t
Log:
Make sure the XSA buggery works on a subclass as well

Modified: Class-Accessor-Grouped/trunk/t/accessors.t
===================================================================
--- Class-Accessor-Grouped/trunk/t/accessors.t	2010-10-08 16:10:38 UTC (rev 9747)
+++ Class-Accessor-Grouped/trunk/t/accessors.t	2010-10-08 16:13:39 UTC (rev 9748)
@@ -16,11 +16,10 @@
     $use_xs = $Class::Accessor::Grouped::USE_XS;
 };
 
-use AccessorGroups;
+use AccessorGroupsSubclass;
 
-my $obj = AccessorGroups->new;
-
 {
+    my $obj = AccessorGroups->new;
     my $class = ref $obj;
     my $name = 'multiple1';
     my $alias = "_${name}_accessor";
@@ -32,7 +31,6 @@
     is(sub_fullname($alias_accessor), join('::',$class,$alias), 'alias FQ name');
 
     my $warned = 0;
-
     local $SIG{__WARN__} = sub {
         if  (shift =~ /DESTROY/i) {
             $warned++;
@@ -42,10 +40,13 @@
     no warnings qw/once/;
     local *AccessorGroups::DESTROY = sub {};
 
-    $obj->mk_group_accessors('warnings', 'DESTROY');
+    $class->mk_group_accessors('warnings', 'DESTROY');
     ok($warned);
-}
+};
 
+
+my $obj = AccessorGroupsSubclass->new;
+
 my $test_accessors = {
     singlefield => {
         is_xs => $use_xs,

Added: Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsSubclass.pm
===================================================================
--- Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsSubclass.pm	                        (rev 0)
+++ Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsSubclass.pm	2010-10-08 16:13:39 UTC (rev 9748)
@@ -0,0 +1,6 @@
+package AccessorGroupsSubclass;
+use strict;
+use warnings;
+use base 'AccessorGroups';
+
+1;