From: Guillermo Roditi Date: Tue, 24 Mar 2009 21:20:45 +0000 (+0000) Subject: subname stuff + tests X-Git-Tag: v0.09004~24 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1ee74bdd5572ee7ee2826527c7f31188326810dc;p=p5sagit%2FClass-Accessor-Grouped.git subname stuff + tests --- diff --git a/Changes b/Changes index d3f3295..58a5736 100644 --- 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 diff --git a/Makefile.PL b/Makefile.PL index b05c64c..8b78312 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -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"; diff --git a/lib/Class/Accessor/Grouped.pm b/lib/Class/Accessor/Grouped.pm index 514b27b..370593a 100644 --- a/lib/Class/Accessor/Grouped.pm +++ b/lib/Class/Accessor/Grouped.pm @@ -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"} } } diff --git a/t/accessors.t b/t/accessors.t index 10256d6..1703e12 100644 --- a/t/accessors.t +++ b/t/accessors.t @@ -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";