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