t/accessors.t

   1 use Test::More no_plan;
   2 use strict;
   3 use warnings;
   4 use lib 't/lib';
   5 use AccessorGroups;
   6
   7 my $class = AccessorGroups->new;
   8
   9 {
  10     my $warned = 0;
  11
  12     local $SIG{__WARN__} = sub {
  13         if  (shift =~ /DESTROY/i) {
  14             $warned++;
  15         };
  16     };
  17
  18     $class->mk_group_accessors('warnings', 'DESTROY');
  19
  20     ok($warned);
  21 };
  22
  23 foreach (qw/singlefield multiple1 multiple2/) {
  24     my $name = $_;
  25     my $alias = "_${name}_accessor";
  26
  27     can_ok($class, $name, $alias);
  28
  29     is($class->$name, undef);
  30     is($class->$alias, undef);
  31
  32     # get/set via name
  33     is($class->$name('a'), 'a');
  34     is($class->$name, 'a');
  35     is($class->{$name}, 'a');
  36
  37     # alias gets same as name
  38     is($class->$alias, 'a');
  39
  40     # get/set via alias
  41     is($class->$alias('b'), 'b');
  42     is($class->$alias, 'b');
  43     is($class->{$name}, 'b');
  44
  45     # alias gets same as name
  46     is($class->$name, 'b');
  47 };
  48
  49 foreach (qw/lr1 lr2/) {
  50     my $name = "$_".'name';
  51     my $alias = "_${name}_accessor";
  52     my $field = "$_".'field';
  53
  54     can_ok($class, $name, $alias);
  55     ok(!$class->can($field));
  56
  57     is($class->$name, undef);
  58     is($class->$alias, undef);
  59
  60     # get/set via name
  61     is($class->$name('c'), 'c');
  62     is($class->$name, 'c');
  63     is($class->{$field}, 'c');
  64
  65     # alias gets same as name
  66     is($class->$alias, 'c');
  67
  68     # get/set via alias
  69     is($class->$alias('d'), 'd');
  70     is($class->$alias, 'd');
  71     is($class->{$field}, 'd');
  72
  73     # alias gets same as name
  74     is($class->$name, 'd');
  75 };