Added tests for mk_group_accessors
Christopher H. Laco [Sun, 21 May 2006 03:52:20 +0000 (03:52 +0000)]
t/accessors.t [new file with mode: 0644]
t/lib/AccessorGroups.pm [new file with mode: 0644]

diff --git a/t/accessors.t b/t/accessors.t
new file mode 100644 (file)
index 0000000..71f8405
--- /dev/null
@@ -0,0 +1,75 @@
+use Test::More no_plan;
+use strict;
+use warnings;
+use lib 't/lib';
+use AccessorGroups;
+
+my $class = AccessorGroups->new;
+
+{
+    my $warned = 0;
+
+    local $SIG{__WARN__} = sub {
+        if  (shift =~ /DESTROY/i) {
+            $warned++;
+        };
+    };
+
+    $class->mk_group_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/set via name
+    is($class->$name('a'), 'a');
+    is($class->$name, 'a');
+    is($class->{$name}, 'a');
+
+    # alias gets same as name
+    is($class->$alias, 'a');
+
+    # get/set via alias
+    is($class->$alias('b'), 'b');
+    is($class->$alias, 'b');
+    is($class->{$name}, 'b');
+
+    # alias gets same as name
+    is($class->$name, 'b');
+};
+
+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/set via name
+    is($class->$name('c'), 'c');
+    is($class->$name, 'c');
+    is($class->{$field}, 'c');
+
+    # alias gets same as name
+    is($class->$alias, 'c');
+
+    # get/set via alias
+    is($class->$alias('d'), 'd');
+    is($class->$alias, 'd');
+    is($class->{$field}, 'd');
+
+    # alias gets same as name
+    is($class->$name, 'd');
+};
diff --git a/t/lib/AccessorGroups.pm b/t/lib/AccessorGroups.pm
new file mode 100644 (file)
index 0000000..97bf7f1
--- /dev/null
@@ -0,0 +1,24 @@
+package AccessorGroups;
+use strict;
+use warnings;
+use base 'Class::Accessor::Grouped';
+
+__PACKAGE__->mk_group_accessors('single', 'singlefield');
+__PACKAGE__->mk_group_accessors('multiple', qw/multiple1 multiple2/);
+__PACKAGE__->mk_group_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;
+    *{"set_$_"} = \&Class::Accessor::Grouped::set_simple;
+};
+
+# make cleanup DESTROY happy
+sub get_warnings {};
+
+1;