t/accessors.t

   1 use Test::More tests => 62;
   2 use strict;
   3 use warnings;
   4 use lib 't/lib';
   5 use AccessorGroups;
   6 use Sub::Identify qw/sub_name sub_fullname/;;
   7
   8 my $class = AccessorGroups->new;
   9
  10 {
  11     my $warned = 0;
  12
  13     local $SIG{__WARN__} = sub {
  14         if  (shift =~ /DESTROY/i) {
  15             $warned++;
  16         };
  17     };
  18
  19     $class->mk_group_accessors('warnings', 'DESTROY');
  20
  21     ok($warned);
  22
  23     # restore non-accessorized DESTROY
  24     no warnings;
  25     *AccessorGroups::DESTROY = sub {};
  26 };
  27
  28 {
  29   my $class_name = ref $class;
  30   my $name = 'multiple1';
  31   my $alias = "_${name}_accessor";
  32   my $accessor = $class->can($name);
  33   my $alias_accessor = $class->can($alias);
  34   isnt(sub_name($accessor), '__ANON__', 'accessor is named');
  35   isnt(sub_name($alias_accessor), '__ANON__', 'alias is named');
  36   is(sub_fullname($accessor), join('::',$class_name,$name), 'accessor FQ name');
  37   is(sub_fullname($alias_accessor), join('::',$class_name,$alias), 'alias FQ name');
  38 }
  39
  40 foreach (qw/singlefield multiple1 multiple2/) {
  41     my $name = $_;
  42     my $alias = "_${name}_accessor";
  43
  44     can_ok($class, $name, $alias);
  45
  46     is($class->$name, undef);
  47     is($class->$alias, undef);
  48
  49     # get/set via name
  50     is($class->$name('a'), 'a');
  51     is($class->$name, 'a');
  52     is($class->{$name}, 'a');
  53
  54     # alias gets same as name
  55     is($class->$alias, 'a');
  56
  57     # get/set via alias
  58     is($class->$alias('b'), 'b');
  59     is($class->$alias, 'b');
  60     is($class->{$name}, 'b');
  61
  62     # alias gets same as name
  63     is($class->$name, 'b');
  64 };
  65
  66 foreach (qw/lr1 lr2/) {
  67     my $name = "$_".'name';
  68     my $alias = "_${name}_accessor";
  69     my $field = "$_".'field';
  70
  71     can_ok($class, $name, $alias);
  72     ok(!$class->can($field));
  73
  74     is($class->$name, undef);
  75     is($class->$alias, undef);
  76
  77     # get/set via name
  78     is($class->$name('c'), 'c');
  79     is($class->$name, 'c');
  80     is($class->{$field}, 'c');
  81
  82     # alias gets same as name
  83     is($class->$alias, 'c');
  84
  85     # get/set via alias
  86     is($class->$alias('d'), 'd');
  87     is($class->$alias, 'd');
  88     is($class->{$field}, 'd');
  89
  90     # alias gets same as name
  91     is($class->$name, 'd');
  92 };