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

[groditi at dev.catalyst.perl.org]

Author: groditi
Date: 2009-03-24 21:20:45 +0000 (Tue, 24 Mar 2009)
New Revision: 5812

Modified:
   trunk/Class-Accessor-Grouped/Changes
   trunk/Class-Accessor-Grouped/Makefile.PL
   trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
   trunk/Class-Accessor-Grouped/t/accessors.t
Log:
subname stuff + tests

Modified: trunk/Class-Accessor-Grouped/Changes
===================================================================
--- trunk/Class-Accessor-Grouped/Changes	2009-03-24 09:10:07 UTC (rev 5811)
+++ trunk/Class-Accessor-Grouped/Changes	2009-03-24 21:20:45 UTC (rev 5812)
@@ -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
 

Modified: trunk/Class-Accessor-Grouped/Makefile.PL
===================================================================
--- trunk/Class-Accessor-Grouped/Makefile.PL	2009-03-24 09:10:07 UTC (rev 5811)
+++ trunk/Class-Accessor-Grouped/Makefile.PL	2009-03-24 21:20:45 UTC (rev 5812)
@@ -12,7 +12,10 @@
 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";
 
 auto_install;

Modified: trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm
===================================================================
--- trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2009-03-24 09:10:07 UTC (rev 5811)
+++ trunk/Class-Accessor-Grouped/lib/Class/Accessor/Grouped.pm	2009-03-24 21:20:45 UTC (rev 5812)
@@ -5,6 +5,7 @@
 use Class::Inspector ();
 use Scalar::Util ();
 use MRO::Compat;
+use Sub::Name ();
 
 our $VERSION = '0.08003';
 
@@ -76,12 +77,15 @@
             ($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"}
         }
     }

Modified: trunk/Class-Accessor-Grouped/t/accessors.t
===================================================================
--- trunk/Class-Accessor-Grouped/t/accessors.t	2009-03-24 09:10:07 UTC (rev 5811)
+++ trunk/Class-Accessor-Grouped/t/accessors.t	2009-03-24 21:20:45 UTC (rev 5812)
@@ -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 @@
     *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";