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