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

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2010-10-08 12:51:58 +0100 (Fri, 08 Oct 2010)
New Revision: 9744

Modified:
   Class-Accessor-Grouped/trunk/t/accessors.t
   Class-Accessor-Grouped/trunk/t/accessors_xs.t
   Class-Accessor-Grouped/trunk/t/lib/AccessorGroups.pm
   Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsRO.pm
   Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsWO.pm
Log:
Cleanup/consolidate main test

Modified: Class-Accessor-Grouped/trunk/t/accessors.t
===================================================================
--- Class-Accessor-Grouped/trunk/t/accessors.t	2010-10-08 11:49:47 UTC (rev 9743)
+++ Class-Accessor-Grouped/trunk/t/accessors.t	2010-10-08 11:51:58 UTC (rev 9744)
@@ -8,10 +8,12 @@
 # from the accessor_xs test-umbrella
 # Also make sure a rogue envvar will not interfere with
 # things
+my $use_xs;
 BEGIN {
     $Class::Accessor::Grouped::USE_XS = 0
         unless defined $Class::Accessor::Grouped::USE_XS;
     $ENV{CAG_USE_XS} = 1;
+    $use_xs = $Class::Accessor::Grouped::USE_XS;
 };
 
 use AccessorGroups;
@@ -48,11 +50,30 @@
   is(sub_fullname($alias_accessor), join('::',$class_name,$alias), 'alias FQ name');
 }
 
-foreach (qw/singlefield multiple1 multiple2/) {
-    my $name = $_;
+my $test_accessors = {
+    singlefield => {
+        is_xs => $use_xs,
+    },
+    multiple1 => {
+    },
+    multiple2 => {
+    },
+    lr1name => {
+        custom_field => 'lr1;field',
+    },
+    lr2name => {
+        custom_field => "lr2'field",
+    },
+};
+
+
+for my $name (sort keys %$test_accessors) {
     my $alias = "_${name}_accessor";
+    my $field = $test_accessors->{$name}{custom_field} || $name;
 
     can_ok($class, $name, $alias);
+    ok(!$class->can($field))
+      if $field ne $name;
 
     is($class->$name, undef);
     is($class->$alias, undef);
@@ -60,7 +81,7 @@
     # get/set via name
     is($class->$name('a'), 'a');
     is($class->$name, 'a');
-    is($class->{$name}, 'a');
+    is($class->{$field}, 'a');
 
     # alias gets same as name
     is($class->$alias, 'a');
@@ -68,40 +89,11 @@
     # get/set via alias
     is($class->$alias('b'), 'b');
     is($class->$alias, 'b');
-    is($class->{$name}, 'b');
+    is($class->{$field}, 'b');
 
     # alias gets same as name
     is($class->$name, 'b');
 };
 
-foreach (qw/lr1 lr2/) {
-    my $name = "$_".'name';
-    my $alias = "_${name}_accessor";
-
-    my $field = { lr1 => 'lr1;field', lr2 => q{lr2'field} }->{$_};
-
-    can_ok($class, $name, $alias);
-    ok(!$class->can($field));
-
-    is($class->$name, undef);
-    is($class->$alias, undef);
-
-    # get/set via name
-    is($class->$name('c'), 'c');
-    is($class->$name, 'c');
-    is($class->{$field}, 'c');
-
-    # alias gets same as name
-    is($class->$alias, 'c');
-
-    # get/set via alias
-    is($class->$alias('d'), 'd');
-    is($class->$alias, 'd');
-    is($class->{$field}, 'd');
-
-    # alias gets same as name
-    is($class->$name, 'd');
-};
-
 # important
 1;

Modified: Class-Accessor-Grouped/trunk/t/accessors_xs.t
===================================================================
--- Class-Accessor-Grouped/trunk/t/accessors_xs.t	2010-10-08 11:49:47 UTC (rev 9743)
+++ Class-Accessor-Grouped/trunk/t/accessors_xs.t	2010-10-08 11:51:58 UTC (rev 9744)
@@ -16,7 +16,7 @@
       if $@;
 }
 
-# rerun all 3 tests under XSAccessor
+# rerun the regular 3 tests under XSAccessor
 $Class::Accessor::Grouped::USE_XS = 1;
 for (qw/accessors.t accessors_ro.t accessors_wo.t/) {
   subtest "$_ with USE_XS" => sub { require( catfile($Bin, $_) ) }

Modified: Class-Accessor-Grouped/trunk/t/lib/AccessorGroups.pm
===================================================================
--- Class-Accessor-Grouped/trunk/t/lib/AccessorGroups.pm	2010-10-08 11:49:47 UTC (rev 9743)
+++ Class-Accessor-Grouped/trunk/t/lib/AccessorGroups.pm	2010-10-08 11:51:58 UTC (rev 9744)
@@ -4,11 +4,17 @@
 use base 'Class::Accessor::Grouped';
 
 __PACKAGE__->mk_group_accessors('simple', 'singlefield');
-__PACKAGE__->mk_group_accessors('simple', qw/multiple1 multiple2/);
-__PACKAGE__->mk_group_accessors('simple', [qw/lr1name lr1;field/], [qw/lr2name lr2'field/]);
+__PACKAGE__->mk_group_accessors('multiple', qw/multiple1 multiple2/);
+__PACKAGE__->mk_group_accessors('listref', [qw/lr1name lr1;field/], [qw/lr2name lr2'field/]);
 
 sub new {
     return bless {}, shift;
 };
 
+foreach (qw/multiple listref/) {
+    no strict 'refs';
+    *{"get_$_"} = __PACKAGE__->can('get_simple');
+    *{"set_$_"} = __PACKAGE__->can('set_simple');
+};
+
 1;

Modified: Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsRO.pm
===================================================================
--- Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsRO.pm	2010-10-08 11:49:47 UTC (rev 9743)
+++ Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsRO.pm	2010-10-08 11:51:58 UTC (rev 9744)
@@ -13,8 +13,7 @@
 
 foreach (qw/multiple listref/) {
     no strict 'refs';
-
-    *{"get_$_"} = \&Class::Accessor::Grouped::get_simple;
+    *{"get_$_"} = __PACKAGE__->can ('get_simple');
 };
 
 1;

Modified: Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsWO.pm
===================================================================
--- Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsWO.pm	2010-10-08 11:49:47 UTC (rev 9743)
+++ Class-Accessor-Grouped/trunk/t/lib/AccessorGroupsWO.pm	2010-10-08 11:51:58 UTC (rev 9744)
@@ -13,8 +13,7 @@
 
 foreach (qw/multiple listref/) {
     no strict 'refs';
-
-    *{"set_$_"} = \&Class::Accessor::Grouped::set_simple;
+    *{"set_$_"} = __PACKAGE__->can('set_simple');
 };
 
 1;