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

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2010-10-08 17:59:29 +0100 (Fri, 08 Oct 2010)
New Revision: 9749

Modified:
   Class-Accessor-Grouped/trunk/Makefile.PL
   Class-Accessor-Grouped/trunk/t/accessors.t
Log:
Using an XS module as test_requires is too evil

Modified: Class-Accessor-Grouped/trunk/Makefile.PL
===================================================================
--- Class-Accessor-Grouped/trunk/Makefile.PL	2010-10-08 16:13:39 UTC (rev 9748)
+++ Class-Accessor-Grouped/trunk/Makefile.PL	2010-10-08 16:59:29 UTC (rev 9749)
@@ -14,7 +14,6 @@
 requires 'Class::Inspector';
 requires 'Sub::Name' => '0.04';
 
-test_requires 'Sub::Identify';
 test_requires 'Test::More' => '0.94';
 test_requires 'Test::Exception';
 

Modified: Class-Accessor-Grouped/trunk/t/accessors.t
===================================================================
--- Class-Accessor-Grouped/trunk/t/accessors.t	2010-10-08 16:13:39 UTC (rev 9748)
+++ Class-Accessor-Grouped/trunk/t/accessors.t	2010-10-08 16:59:29 UTC (rev 9749)
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 use lib 't/lib';
-use Sub::Identify qw/sub_name sub_fullname/;
+use B qw/svref_2object/;
 
 # we test the pure-perl versions only, but allow overrides
 # from the accessor_xs test-umbrella
@@ -19,17 +19,17 @@
 use AccessorGroupsSubclass;
 
 {
-    my $obj = AccessorGroups->new;
+    my $obj = AccessorGroupsSubclass->new;
     my $class = ref $obj;
     my $name = 'multiple1';
     my $alias = "_${name}_accessor";
-    my $accessor = $obj->can($name);
-    my $alias_accessor = $obj->can($alias);
-    isnt(sub_name($accessor), '__ANON__', 'accessor is named');
-    isnt(sub_name($alias_accessor), '__ANON__', 'alias is named');
-    is(sub_fullname($accessor), join('::',$class,$name), 'accessor FQ name');
-    is(sub_fullname($alias_accessor), join('::',$class,$alias), 'alias FQ name');
 
+    for my $meth ($name, $alias) {
+        my $cv = svref_2object( $obj->can($meth) );
+        is($cv->GV->NAME, $meth, "$meth accessor is named");
+        is($cv->GV->STASH->NAME, 'AccessorGroups', "$meth class correct");
+    }
+
     my $warned = 0;
     local $SIG{__WARN__} = sub {
         if  (shift =~ /DESTROY/i) {
@@ -38,7 +38,7 @@
     };
 
     no warnings qw/once/;
-    local *AccessorGroups::DESTROY = sub {};
+    local *AccessorGroupsSubclass::DESTROY = sub {};
 
     $class->mk_group_accessors('warnings', 'DESTROY');
     ok($warned);