1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
=pod
is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
is => rw, accessor => _foo # turns into (accessor => _foo)
is => ro, accessor => _foo # error, accesor is rw
=cut
sub make_class {
my ($is, $attr, $class) = @_;
eval "package $class; use Moose; has 'foo' => ( is => '$is', $attr => '_foo' );";
return $@ ? die $@ : $class;
}
my $obj;
my $class;
$class = make_class('rw', 'writer', 'Test::Class::WriterRW');
ok($class, "Can define attr with rw + writer");
$obj = $class->new();
can_ok($obj, qw/foo _foo/);
lives_ok {$obj->_foo(1)} "$class->_foo is writer";
is($obj->foo(), 1, "$class->foo is reader");
dies_ok {$obj->foo(2)} "$class->foo is not writer"; # this should fail
ok(!defined $obj->_foo(), "$class->_foo is not reader");
$class = make_class('ro', 'writer', 'Test::Class::WriterRO');
ok($class, "Can define attr with ro + writer");
$obj = $class->new();
can_ok($obj, qw/foo _foo/);
lives_ok {$obj->_foo(1)} "$class->_foo is writer";
is($obj->foo(), 1, "$class->foo is reader");
dies_ok {$obj->foo(1)} "$class->foo is not writer";
isnt($obj->_foo(), 1, "$class->_foo is not reader");
$class = make_class('rw', 'accessor', 'Test::Class::AccessorRW');
ok($class, "Can define attr with rw + accessor");
$obj = $class->new();
can_ok($obj, qw/_foo/);
lives_ok {$obj->_foo(1)} "$class->_foo is writer";
is($obj->_foo(), 1, "$class->foo is reader");
dies_ok { make_class('ro', 'accessor', "Test::Class::AccessorRO"); } "Cant define attr with ro + accessor";
done_testing;
|
