1use Test::More tests => 38; 2use strict; 3use warnings; 4use lib 't/lib'; 5use AccessorGroupsWO; 6 7my $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 27foreach (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 53foreach (qw/lr1 lr2/) { 54 my $name = "$_".'name'; 55 my $alias = "_${name}_accessor"; 56 my $field = "$_".'field'; 57 58 can_ok($class, $name, $alias); 59 ok(!$class->can($field)); 60 61 # set via name 62 is($class->$name('c'), 'c'); 63 is($class->{$field}, 'c'); 64 65 # alias sets same as name 66 is($class->$alias('d'), 'd'); 67 is($class->{$field}, 'd'); 68 69 # die on get via name/alias 70 eval { 71 $class->$name; 72 }; 73 ok($@ =~ /cannot access/); 74 75 eval { 76 $class->$alias; 77 }; 78 ok($@ =~ /cannot access/); 79}; 80