Commit | Line | Data |
4060c871 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 29; |
7 | use Test::Exception; |
8 | |
9 | use Scalar::Util 'isweak'; |
10 | |
11 | |
12 | |
13 | { |
14 | package Foo; |
15 | use Mouse; |
16 | |
17 | eval { |
18 | has 'foo' => ( |
19 | reader => 'get_foo', |
20 | writer => 'set_foo', |
21 | ); |
22 | }; |
23 | ::ok(!$@, '... created the writer method okay'); |
24 | |
25 | eval { |
26 | has 'foo_required' => ( |
27 | reader => 'get_foo_required', |
28 | writer => 'set_foo_required', |
29 | required => 1, |
30 | ); |
31 | }; |
32 | ::ok(!$@, '... created the required writer method okay'); |
33 | |
34 | eval { |
35 | has 'foo_int' => ( |
36 | reader => 'get_foo_int', |
37 | writer => 'set_foo_int', |
38 | isa => 'Int', |
39 | ); |
40 | }; |
41 | ::ok(!$@, '... created the writer method with type constraint okay'); |
42 | |
43 | eval { |
44 | has 'foo_weak' => ( |
45 | reader => 'get_foo_weak', |
46 | writer => 'set_foo_weak', |
47 | weak_ref => 1 |
48 | ); |
49 | }; |
50 | ::ok(!$@, '... created the writer method with weak_ref okay'); |
51 | } |
52 | |
53 | { |
54 | my $foo = Foo->new(foo_required => 'required'); |
55 | isa_ok($foo, 'Foo'); |
56 | |
57 | # regular writer |
58 | |
59 | can_ok($foo, 'set_foo'); |
60 | is($foo->get_foo(), undef, '... got an unset value'); |
61 | lives_ok { |
62 | $foo->set_foo(100); |
63 | } '... set_foo wrote successfully'; |
64 | is($foo->get_foo(), 100, '... got the correct set value'); |
65 | |
66 | ok(!isweak($foo->{foo}), '... it is not a weak reference'); |
67 | |
68 | # required writer |
69 | |
70 | dies_ok { |
71 | Foo->new; |
72 | } '... cannot create without the required attribute'; |
73 | |
74 | can_ok($foo, 'set_foo_required'); |
75 | is($foo->get_foo_required(), 'required', '... got an unset value'); |
76 | lives_ok { |
77 | $foo->set_foo_required(100); |
78 | } '... set_foo_required wrote successfully'; |
79 | is($foo->get_foo_required(), 100, '... got the correct set value'); |
80 | |
81 | dies_ok { |
82 | $foo->set_foo_required(); |
83 | } '... set_foo_required died successfully with no value'; |
84 | |
85 | lives_ok { |
86 | $foo->set_foo_required(undef); |
87 | } '... set_foo_required did accept undef'; |
88 | |
89 | ok(!isweak($foo->{foo_required}), '... it is not a weak reference'); |
90 | |
91 | # with type constraint |
92 | |
93 | can_ok($foo, 'set_foo_int'); |
94 | is($foo->get_foo_int(), undef, '... got an unset value'); |
95 | lives_ok { |
96 | $foo->set_foo_int(100); |
97 | } '... set_foo_int wrote successfully'; |
98 | is($foo->get_foo_int(), 100, '... got the correct set value'); |
99 | |
100 | dies_ok { |
101 | $foo->set_foo_int("Foo"); |
102 | } '... set_foo_int died successfully'; |
103 | |
104 | ok(!isweak($foo->{foo_int}), '... it is not a weak reference'); |
105 | |
106 | # with weak_ref |
107 | |
108 | my $test = []; |
109 | |
110 | can_ok($foo, 'set_foo_weak'); |
111 | is($foo->get_foo_weak(), undef, '... got an unset value'); |
112 | lives_ok { |
113 | $foo->set_foo_weak($test); |
114 | } '... set_foo_weak wrote successfully'; |
115 | is($foo->get_foo_weak(), $test, '... got the correct set value'); |
116 | |
117 | ok(isweak($foo->{foo_weak}), '... it is a weak reference'); |
118 | } |
119 | |
120 | |
121 | |