From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 8 Oct 2010 16:59:29 +0000 (+0000)
Subject: Using an XS module as test_requires is too evil
X-Git-Tag: v0.09007~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1dc76a1158e9fc465cf8f59bfd91d7cd8d611ae;p=p5sagit%2FClass-Accessor-Grouped.git

Using an XS module as test_requires is too evil
---

diff --git a/Makefile.PL b/Makefile.PL
index e4588f6..3ff7204 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -14,7 +14,6 @@ requires 'MRO::Compat';
 requires 'Class::Inspector';
 requires 'Sub::Name' => '0.04';
 
-test_requires 'Sub::Identify';
 test_requires 'Test::More' => '0.94';
 test_requires 'Test::Exception';
 
diff --git a/t/accessors.t b/t/accessors.t
index 99b8d44..7a72e5e 100644
--- a/t/accessors.t
+++ b/t/accessors.t
@@ -2,7 +2,7 @@ use Test::More tests => 62;
 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,16 +19,16 @@ BEGIN {
 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 {
@@ -38,7 +38,7 @@ use AccessorGroupsSubclass;
     };
 
     no warnings qw/once/;
-    local *AccessorGroups::DESTROY = sub {};
+    local *AccessorGroupsSubclass::DESTROY = sub {};
 
     $class->mk_group_accessors('warnings', 'DESTROY');
     ok($warned);