subname stuff + tests
Guillermo Roditi [Tue, 24 Mar 2009 21:20:45 +0000 (21:20 +0000)]
Changes
Makefile.PL
lib/Class/Accessor/Grouped.pm
t/accessors.t

diff --git a/Changes b/Changes
index d3f3295..58a5736 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Class::Accessor::Grouped.
 
+0.08004 
+    - Make _mk_group_accessors name the closures installed for Moose compat
+
 0.08003 Sat Mar 21 9:27:24 2009
     - Fixed set_inherited under C3::Componentised: RT#43702, RIBASUSHI
 
index b05c64c..8b78312 100644 (file)
@@ -12,6 +12,9 @@ requires 'Carp';
 requires 'Scalar::Util';
 requires 'MRO::Compat';
 requires 'Class::Inspector';
+requires 'Sub::Name' => '0.04';
+
+test_requires 'Sub::Identify';
 
 clean_files "Class-Accessor-Grouped-* t/var";
 
index 514b27b..370593a 100644 (file)
@@ -5,6 +5,7 @@ use Carp ();
 use Class::Inspector ();
 use Scalar::Util ();
 use MRO::Compat;
+use Sub::Name ();
 
 our $VERSION = '0.08003';
 
@@ -76,12 +77,15 @@ sub mk_group_accessors {
             ($name, $field) = @$field if ref $field;
 
             my $accessor = $self->$maker($group, $field);
+            my $alias_accessor = $self->$maker($group, $field);
+
             my $alias = "_${name}_accessor";
+            my $full_name = join('::', $class, $name);
+            my $full_alias = join('::', $class, $alias);
 
-            *{$class."\:\:$name"}  = $accessor;
+            *$full_name = Sub::Name::subname($full_name, $accessor);
               #unless defined &{$class."\:\:$field"}
-
-            *{$class."\:\:$alias"}  = $accessor;
+            *$full_alias = Sub::Name::subname($full_alias, $alias_accessor);
               #unless defined &{$class."\:\:$alias"}
         }
     }
index 10256d6..1703e12 100644 (file)
@@ -1,8 +1,9 @@
-use Test::More tests => 58;
+use Test::More tests => 62;
 use strict;
 use warnings;
 use lib 't/lib';
 use AccessorGroups;
+use Sub::Identify qw/sub_name sub_fullname/;;
 
 my $class = AccessorGroups->new;
 
@@ -24,6 +25,18 @@ my $class = AccessorGroups->new;
     *AccessorGroups::DESTROY = sub {};
 };
 
+{
+  my $class_name = ref $class;
+  my $name = 'multiple1';
+  my $alias = "_${name}_accessor";
+  my $accessor = $class->can($name);
+  my $alias_accessor = $class->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,$name), 'accessor FQ name');
+  is(sub_fullname($alias_accessor), join('::',$class_name,$alias), 'alias FQ name');
+}
+
 foreach (qw/singlefield multiple1 multiple2/) {
     my $name = $_;
     my $alias = "_${name}_accessor";