Added tests for mk_group_ro_accessors

diff --git a/t/accessors_ro.t b/t/accessors_ro.t
new file mode 100644 (file)
index 0000000..662095d
--- /dev/null
+++ b/t/accessors_ro.t
@@ -0,0 +1,87 @@
+use Test::More no_plan;
+use strict;
+use warnings;
+use lib 't/lib';
+use AccessorGroupsRO;
+
+my $class = AccessorGroupsRO->new;
+
+{
+    my $warned = 0;
+
+    local $SIG{__WARN__} = sub {
+        if  (shift =~ /DESTROY/i) {
+            $warned++;
+        };
+    };
+
+    $class->mk_group_ro_accessors('warnings', 'DESTROY');
+
+    ok($warned);
+};
+
+foreach (qw/singlefield multiple1 multiple2/) {
+    my $name = $_;
+    my $alias = "_${name}_accessor";
+
+    can_ok($class, $name, $alias);
+
+    is($class->$name, undef);
+    is($class->$alias, undef);
+
+    # get via name
+    $class->{$name} = 'a';
+    is($class->$name, 'a');
+
+    # alias gets same as name
+    is($class->$alias, 'a');
+
+    # die on set via name/alias
+    eval {
+        $class->$name('b');
+    };
+    ok($@ =~ /cannot alter/);
+
+    eval {
+        $class->$alias('b');
+    };
+    ok($@ =~ /cannot alter/);
+
+    # value should be unchanged
+    is($class->$name, 'a');
+    is($class->$alias, 'a');
+};
+
+foreach (qw/lr1 lr2/) {
+    my $name = "$_".'name';
+    my $alias = "_${name}_accessor";
+    my $field = "$_".'field';
+
+    can_ok($class, $name, $alias);
+    ok(!$class->can($field));
+
+    is($class->$name, undef);
+    is($class->$alias, undef);
+
+    # get via name
+    $class->{$field} = 'c';
+    is($class->$name, 'c');
+
+    # alias gets same as name
+    is($class->$alias, 'c');
+
+    # die on set via name/alias
+    eval {
+        $class->$name('d');
+    };
+    ok($@ =~ /cannot alter/);
+
+    eval {
+        $class->$alias('d');
+    };
+    ok($@ =~ /cannot alter/);
+
+    # value should be unchanged
+    is($class->$name, 'c');
+    is($class->$alias, 'c');
+};

diff --git a/t/lib/AccessorGroupsRO.pm b/t/lib/AccessorGroupsRO.pm
new file mode 100644 (file)
index 0000000..f666458
--- /dev/null
+++ b/t/lib/AccessorGroupsRO.pm
@@ -0,0 +1,23 @@
+package AccessorGroupsRO;
+use strict;
+use warnings;
+use base 'Class::Accessor::Grouped';
+
+__PACKAGE__->mk_group_ro_accessors('single', 'singlefield');
+__PACKAGE__->mk_group_ro_accessors('multiple', qw/multiple1 multiple2/);
+__PACKAGE__->mk_group_ro_accessors('listref', [qw/lr1name lr1field/], [qw/lr2name lr2field/]);
+
+sub new {
+    return bless {}, shift;
+};
+
+foreach (qw/single multiple listref/) {
+    no strict 'refs';
+
+    *{"get_$_"} = \&Class::Accessor::Grouped::get_simple;
+};
+
+# make cleanup DESTROY happy
+sub get_warnings {};
+
+1;