← Back to branch summary

~ubuntu-branches/ubuntu/wily/libclass-accessor-grouped-perl/wily

« back to all changes in this revision

Viewing changes to t/accessors_wo.t

  • Committer: Bazaar Package Importer
  • Author(s): gregor herrmann, Ansgar Burchardt, Antony Gelberg, gregor herrmann
  • Date: 2011-01-24 18:49:35 UTC
  • mfrom: (1.1.9 upstream)
  • Revision ID: james.westby@ubuntu.com-20110124184935-j6jm3u3vn42tklq0
Tags: 0.10002-1
[ Ansgar Burchardt ]
* Update my email address.

[ Antony Gelberg ]
* New upstream release

[ gregor herrmann ]
* debian/copyright: update formatting and list of packagers.
* debian/control: update build dependencies.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/accessors_wo.t
18
18
 
19
19
use AccessorGroupsWO;
20
20
 
21
 
my $class = AccessorGroupsWO->new;
 
21
my $obj = AccessorGroupsWO->new;
22
22
 
23
23
{
24
24
    my $warned = 0;
29
29
        };
30
30
    };
31
31
 
32
 
    $class->mk_group_wo_accessors('warnings', 'DESTROY');
 
32
    no warnings qw/once/;
 
33
    local *AccessorGroupsWO::DESTROY = sub {};
33
34
 
 
35
    $obj->mk_group_wo_accessors('warnings', 'DESTROY');
34
36
    ok($warned);
35
 
 
36
 
    # restore non-accessorized DESTROY
37
 
    no warnings;
38
 
    *AccessorGroupsWO::DESTROY = sub {};
39
37
};
40
38
 
41
39
my $test_accessors = {
59
57
    my $alias = "_${name}_accessor";
60
58
    my $field = $test_accessors->{$name}{custom_field} || $name;
61
59
 
62
 
    can_ok($class, $name, $alias);
 
60
    can_ok($obj, $name, $alias);
63
61
 
64
 
    ok(!$class->can($field))
 
62
    ok(!$obj->can($field))
65
63
      if $field ne $name;
66
64
 
67
65
    # set via name
68
 
    is($class->$name('a'), 'a');
69
 
    is($class->{$field}, 'a');
 
66
    is($obj->$name('a'), 'a');
 
67
    is($obj->{$field}, 'a');
70
68
 
71
69
    # alias sets same as name
72
 
    is($class->$alias('b'), 'b');
73
 
    is($class->{$field}, 'b');
 
70
    is($obj->$alias('b'), 'b');
 
71
    is($obj->{$field}, 'b');
74
72
 
75
73
    my $wo_regex = $test_accessors->{$name}{is_xs}
76
74
        ? qr/Usage\:.+$name.*\(self, newvalue\)/
79
77
 
80
78
    # die on get via name/alias
81
79
    throws_ok {
82
 
        $class->$name;
 
80
        $obj->$name;
83
81
    } $wo_regex;
84
82
 
85
83
    throws_ok {
86
 
        $class->$alias;
 
84
        $obj->$alias;
87
85
    } $wo_regex;
88
86
};
89
87