Added tests for mk_group_wo_accessors
Christopher H. Laco [Sun, 21 May 2006 16:02:54 +0000 (16:02 +0000)]
Updated all test plans to use real test counts

t/accessors.t
t/accessors_ro.t
t/accessors_wo.t [new file with mode: 0644]
t/lib/AccessorGroups.pm
t/lib/AccessorGroupsRO.pm
t/lib/AccessorGroupsWO.pm [new file with mode: 0644]

index 71f8405..10256d6 100644 (file)
@@ -1,4 +1,4 @@
-use Test::More no_plan;
+use Test::More tests => 58;
 use strict;
 use warnings;
 use lib 't/lib';
@@ -18,6 +18,10 @@ my $class = AccessorGroups->new;
     $class->mk_group_accessors('warnings', 'DESTROY');
 
     ok($warned);
+
+    # restore non-accessorized DESTROY
+    no warnings;
+    *AccessorGroups::DESTROY = sub {};
 };
 
 foreach (qw/singlefield multiple1 multiple2/) {
index 662095d..bde31c9 100644 (file)
@@ -1,4 +1,4 @@
-use Test::More no_plan;
+use Test::More tests => 48;
 use strict;
 use warnings;
 use lib 't/lib';
@@ -18,6 +18,10 @@ my $class = AccessorGroupsRO->new;
     $class->mk_group_ro_accessors('warnings', 'DESTROY');
 
     ok($warned);
+
+    # restore non-accessorized DESTROY
+    no warnings;
+    *AccessorGroupsRO::DESTROY = sub {};
 };
 
 foreach (qw/singlefield multiple1 multiple2/) {
diff --git a/t/accessors_wo.t b/t/accessors_wo.t
new file mode 100644 (file)
index 0000000..6700eb2
--- /dev/null
@@ -0,0 +1,79 @@
+use Test::More tests => 38;
+use strict;
+use warnings;
+use lib 't/lib';
+use AccessorGroupsWO;
+
+my $class = AccessorGroupsWO->new;
+
+{
+    my $warned = 0;
+
+    local $SIG{__WARN__} = sub {
+        if  (shift =~ /DESTROY/i) {
+            $warned++;
+        };
+    };
+
+    $class->mk_group_wo_accessors('warnings', 'DESTROY');
+
+    ok($warned);
+
+    # restore non-accessorized DESTROY
+    no warnings;
+    *AccessorGroupsWO::DESTROY = sub {};
+};
+
+foreach (qw/singlefield multiple1 multiple2/) {
+    my $name = $_;
+    my $alias = "_${name}_accessor";
+
+    can_ok($class, $name, $alias);
+
+    # set via name
+    is($class->$name('a'), 'a');
+    is($class->{$name}, 'a');
+
+    # alias sets same as name
+    is($class->$alias('b'), 'b');
+    is($class->{$name}, 'b');
+
+    # die on get via name/alias
+    eval {
+        $class->$name;
+    };
+    ok($@ =~ /cannot access/);
+
+    eval {
+        $class->$alias;
+    };
+    ok($@ =~ /cannot access/);
+};
+
+foreach (qw/lr1 lr2/) {
+    my $name = "$_".'name';
+    my $alias = "_${name}_accessor";
+    my $field = "$_".'field';
+
+    can_ok($class, $name, $alias);
+    ok(!$class->can($field));
+
+    # set via name
+    is($class->$name('c'), 'c');
+    is($class->{$field}, 'c');
+
+    # alias sets same as name
+    is($class->$alias('d'), 'd');
+    is($class->{$field}, 'd');
+
+    # die on get via name/alias
+    eval {
+        $class->$name;
+    };
+    ok($@ =~ /cannot access/);
+
+    eval {
+        $class->$alias;
+    };
+    ok($@ =~ /cannot access/);
+};
index 97bf7f1..48e0c7e 100644 (file)
@@ -18,7 +18,4 @@ foreach (qw/single multiple listref/) {
     *{"set_$_"} = \&Class::Accessor::Grouped::set_simple;
 };
 
-# make cleanup DESTROY happy
-sub get_warnings {};
-
 1;
index f666458..688a7c8 100644 (file)
@@ -17,7 +17,4 @@ foreach (qw/single multiple listref/) {
     *{"get_$_"} = \&Class::Accessor::Grouped::get_simple;
 };
 
-# make cleanup DESTROY happy
-sub get_warnings {};
-
 1;
diff --git a/t/lib/AccessorGroupsWO.pm b/t/lib/AccessorGroupsWO.pm
new file mode 100644 (file)
index 0000000..459cc49
--- /dev/null
@@ -0,0 +1,20 @@
+package AccessorGroupsWO;
+use strict;
+use warnings;
+use base 'Class::Accessor::Grouped';
+
+__PACKAGE__->mk_group_wo_accessors('single', 'singlefield');
+__PACKAGE__->mk_group_wo_accessors('multiple', qw/multiple1 multiple2/);
+__PACKAGE__->mk_group_wo_accessors('listref', [qw/lr1name lr1field/], [qw/lr2name lr2field/]);
+
+sub new {
+    return bless {}, shift;
+};
+
+foreach (qw/single multiple listref/) {
+    no strict 'refs';
+
+    *{"set_$_"} = \&Class::Accessor::Grouped::set_simple;
+};
+
+1;