Make sure the XSA buggery works on a subclass as well
Peter Rabbitson [Fri, 8 Oct 2010 16:13:39 +0000 (16:13 +0000)]
t/accessors.t
t/lib/AccessorGroupsSubclass.pm [new file with mode: 0644]

index 6a5f03b..99b8d44 100644 (file)
@@ -16,11 +16,10 @@ BEGIN {
     $use_xs = $Class::Accessor::Grouped::USE_XS;
 };
 
-use AccessorGroups;
-
-my $obj = AccessorGroups->new;
+use AccessorGroupsSubclass;
 
 {
+    my $obj = AccessorGroups->new;
     my $class = ref $obj;
     my $name = 'multiple1';
     my $alias = "_${name}_accessor";
@@ -32,7 +31,6 @@ my $obj = AccessorGroups->new;
     is(sub_fullname($alias_accessor), join('::',$class,$alias), 'alias FQ name');
 
     my $warned = 0;
-
     local $SIG{__WARN__} = sub {
         if  (shift =~ /DESTROY/i) {
             $warned++;
@@ -42,9 +40,12 @@ my $obj = AccessorGroups->new;
     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 => {
diff --git a/t/lib/AccessorGroupsSubclass.pm b/t/lib/AccessorGroupsSubclass.pm
new file mode 100644 (file)
index 0000000..6866c95
--- /dev/null
@@ -0,0 +1,6 @@
+package AccessorGroupsSubclass;
+use strict;
+use warnings;
+use base 'AccessorGroups';
+
+1;