t/accessors_wo.t

   1 use Test::More tests => 38;
   2 use strict;
   3 use warnings;
   4 use lib 't/lib';
   5 use AccessorGroupsWO;
   6
   7 my $class = AccessorGroupsWO->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_wo_accessors('warnings', 'DESTROY');
  19
  20     ok($warned);
  21
  22     # restore non-accessorized DESTROY
  23     no warnings;
  24     *AccessorGroupsWO::DESTROY = sub {};
  25 };
  26
  27 foreach (qw/singlefield multiple1 multiple2/) {
  28     my $name = $_;
  29     my $alias = "_${name}_accessor";
  30
  31     can_ok($class, $name, $alias);
  32
  33     # set via name
  34     is($class->$name('a'), 'a');
  35     is($class->{$name}, 'a');
  36
  37     # alias sets same as name
  38     is($class->$alias('b'), 'b');
  39     is($class->{$name}, 'b');
  40
  41     # die on get via name/alias
  42     eval {
  43         $class->$name;
  44     };
  45     ok($@ =~ /cannot access/);
  46
  47     eval {
  48         $class->$alias;
  49     };
  50     ok($@ =~ /cannot access/);
  51 };
  52
  53 foreach (qw/lr1 lr2/) {
  54     my $name = "$_".'name';
  55     my $alias = "_${name}_accessor";
  56
  57     my $field = { lr1 => 'lr1;field', lr2 => q{lr2'field} }->{$_};
  58
  59     can_ok($class, $name, $alias);
  60     ok(!$class->can($field));
  61
  62     # set via name
  63     is($class->$name('c'), 'c');
  64     is($class->{$field}, 'c');
  65
  66     # alias sets same as name
  67     is($class->$alias('d'), 'd');
  68     is($class->{$field}, 'd');
  69
  70     # die on get via name/alias
  71     eval {
  72         $class->$name;
  73     };
  74     ok($@ =~ /cannot access/);
  75
  76     eval {
  77         $class->$alias;
  78     };
  79     ok($@ =~ /cannot access/);
  80 };