t/accessors_ro.t

   1 use Test::More tests => 48;
   2 use strict;
   3 use warnings;
   4 use lib 't/lib';
   5 use AccessorGroupsRO;
   6
   7 my $class = AccessorGroupsRO->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_ro_accessors('warnings', 'DESTROY');
  19
  20     ok($warned);
  21
  22     # restore non-accessorized DESTROY
  23     no warnings;
  24     *AccessorGroupsRO::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     is($class->$name, undef);
  34     is($class->$alias, undef);
  35
  36     # get via name
  37     $class->{$name} = 'a';
  38     is($class->$name, 'a');
  39
  40     # alias gets same as name
  41     is($class->$alias, 'a');
  42
  43     # die on set via name/alias
  44     eval {
  45         $class->$name('b');
  46     };
  47     ok($@ =~ /cannot alter/);
  48
  49     eval {
  50         $class->$alias('b');
  51     };
  52     ok($@ =~ /cannot alter/);
  53
  54     # value should be unchanged
  55     is($class->$name, 'a');
  56     is($class->$alias, 'a');
  57 };
  58
  59 foreach (qw/lr1 lr2/) {
  60     my $name = "$_".'name';
  61     my $alias = "_${name}_accessor";
  62     my $field = { lr1 => 'lr1;field', lr2 => q{lr2'field} }->{$_};
  63
  64     can_ok($class, $name, $alias);
  65     ok(!$class->can($field));
  66
  67     is($class->$name, undef);
  68     is($class->$alias, undef);
  69
  70     # get via name
  71     $class->{$field} = 'c';
  72     is($class->$name, 'c');
  73
  74     # alias gets same as name
  75     is($class->$alias, 'c');
  76
  77     # die on set via name/alias
  78     eval {
  79         $class->$name('d');
  80     };
  81     ok($@ =~ /cannot alter/);
  82
  83     eval {
  84         $class->$alias('d');
  85     };
  86     ok($@ =~ /cannot alter/);
  87
  88     # value should be unchanged
  89     is($class->$name, 'c');
  90     is($class->$alias, 'c');
  91 };