Excise most redundant explicit return() ops
[p5sagit/Class-Accessor-Grouped.git] / t / accessors_wo.t
CommitLineData
c26cc2b9 1use Test::More tests => 38;
8019c4d8 2use Test::Exception;
c26cc2b9 3use strict;
4use warnings;
395c3fdb 5use Config;
c26cc2b9 6use lib 't/lib';
8019c4d8 7
8# we test the pure-perl versions only, but allow overrides
9# from the accessor_xs test-umbrella
10# Also make sure a rogue envvar will not interfere with
11# things
12my $use_xs;
13BEGIN {
ba8c183b 14 $Class::Accessor::Grouped::USE_XS = 0
15 unless defined $Class::Accessor::Grouped::USE_XS;
16 $ENV{CAG_USE_XS} = 1;
17 $use_xs = $Class::Accessor::Grouped::USE_XS;
8019c4d8 18};
19
c26cc2b9 20use AccessorGroupsWO;
21
84430300 22my $obj = AccessorGroupsWO->new;
c26cc2b9 23
24{
ba8c183b 25 my $warned = 0;
c26cc2b9 26
ba8c183b 27 local $SIG{__WARN__} = sub {
28 if (shift =~ /DESTROY/i) {
29 $warned++;
c26cc2b9 30 };
ba8c183b 31 };
c26cc2b9 32
ba8c183b 33 no warnings qw/once/;
34 local *AccessorGroupsWO::DESTROY = sub {};
c26cc2b9 35
ba8c183b 36 $obj->mk_group_wo_accessors('warnings', 'DESTROY');
37 ok($warned);
c26cc2b9 38};
39
8019c4d8 40my $test_accessors = {
ba8c183b 41 singlefield => {
42 is_xs => $use_xs,
43 },
44 multiple1 => {
45 },
46 multiple2 => {
47 },
48 lr1name => {
49 custom_field => 'lr1;field',
50 },
51 lr2name => {
52 custom_field => "lr2'field",
53 },
8019c4d8 54};
55
56for my $name (sort keys %$test_accessors) {
57
ba8c183b 58 my $alias = "_${name}_accessor";
59 my $field = $test_accessors->{$name}{custom_field} || $name;
c26cc2b9 60
ba8c183b 61 can_ok($obj, $name, $alias);
c26cc2b9 62
ba8c183b 63 ok(!$obj->can($field))
64 if $field ne $name;
8019c4d8 65
ba8c183b 66 # set via name
67 is($obj->$name('a'), 'a');
68 is($obj->{$field}, 'a');
c26cc2b9 69
ba8c183b 70 # alias sets same as name
71 is($obj->$alias('b'), 'b');
72 is($obj->{$field}, 'b');
8ef9b3ff 73
ba8c183b 74 my $wo_regex = $test_accessors->{$name}{is_xs}
75 ? qr/Usage\:.+$name.*\(self, newvalue\)/
76 : qr/cannot access the value of '\Q$field\E'/
77 ;
c26cc2b9 78
ba8c183b 79 # die on get via name/alias
395c3fdb 80 {
81 local $TODO = "Class::XSAccessor emits broken error messages on 5.10 or -DDEBUGGING 5.8"
82 if (
83 $test_accessors->{$name}{is_xs}
84 and
85 $] < '5.011'
86 and
87 ( $] > '5.009' or $Config{config_args} =~ /DEBUGGING/ )
88 );
89
90 throws_ok {
91 $obj->$name;
92 } $wo_regex;
93
94 throws_ok {
95 $obj->$alias;
96 } $wo_regex;
97 }
c26cc2b9 98};
8019c4d8 99
100# important
1011;