Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use File::Spec; |
6 | |
7 | use Class::MOP; |
8 | |
9 | BEGIN { |
10 | require_ok(File::Spec->catfile('examples', 'ClassEncapsulatedAttributes.pod')); |
11 | } |
12 | |
13 | { |
14 | package Foo; |
15 | |
16 | use metaclass 'ClassEncapsulatedAttributes'; |
17 | |
18 | Foo->meta->add_attribute('foo' => ( |
19 | accessor => 'foo', |
20 | predicate => 'has_foo', |
21 | default => 'init in FOO' |
22 | )); |
23 | |
24 | Foo->meta->add_attribute('bar' => ( |
25 | reader => 'get_bar', |
26 | writer => 'set_bar', |
27 | default => 'init in FOO' |
28 | )); |
29 | |
30 | sub new { |
31 | my $class = shift; |
32 | $class->meta->new_object(@_); |
33 | } |
34 | |
35 | package Bar; |
36 | our @ISA = ('Foo'); |
37 | |
38 | Bar->meta->add_attribute('foo' => ( |
39 | accessor => 'foo', |
40 | predicate => 'has_foo', |
41 | default => 'init in BAR' |
42 | )); |
43 | |
44 | Bar->meta->add_attribute('bar' => ( |
45 | reader => 'get_bar', |
46 | writer => 'set_bar', |
47 | default => 'init in BAR' |
48 | )); |
49 | |
50 | sub SUPER_foo { (shift)->SUPER::foo(@_) } |
51 | sub SUPER_has_foo { (shift)->SUPER::foo(@_) } |
52 | sub SUPER_get_bar { (shift)->SUPER::get_bar() } |
53 | sub SUPER_set_bar { (shift)->SUPER::set_bar(@_) } |
54 | |
55 | } |
56 | |
57 | { |
58 | my $foo = Foo->new(); |
59 | isa_ok($foo, 'Foo'); |
60 | |
61 | can_ok($foo, 'foo'); |
62 | can_ok($foo, 'has_foo'); |
63 | can_ok($foo, 'get_bar'); |
64 | can_ok($foo, 'set_bar'); |
65 | |
66 | my $bar = Bar->new(); |
67 | isa_ok($bar, 'Bar'); |
68 | |
69 | can_ok($bar, 'foo'); |
70 | can_ok($bar, 'has_foo'); |
71 | can_ok($bar, 'get_bar'); |
72 | can_ok($bar, 'set_bar'); |
73 | |
74 | ok($foo->has_foo, '... Foo::has_foo == 1'); |
75 | ok($bar->has_foo, '... Bar::has_foo == 1'); |
76 | |
77 | is($foo->foo, 'init in FOO', '... got the right default value for Foo::foo'); |
78 | is($bar->foo, 'init in BAR', '... got the right default value for Bar::foo'); |
79 | |
80 | is($bar->SUPER_foo(), 'init in FOO', '... got the right default value for Bar::SUPER::foo'); |
81 | |
82 | $bar->SUPER_foo(undef); |
83 | |
84 | is($bar->SUPER_foo(), undef, '... successfully set Foo::foo through Bar::SUPER::foo'); |
85 | ok(!$bar->SUPER_has_foo, '... BAR::SUPER::has_foo == 0'); |
86 | |
87 | ok($foo->has_foo, '... Foo::has_foo (is still) 1'); |
88 | } |
89 | |
90 | { |
91 | my $bar = Bar->new( |
92 | 'Foo' => { 'foo' => 'Foo::foo' }, |
93 | 'Bar' => { 'foo' => 'Bar::foo' } |
94 | ); |
95 | isa_ok($bar, 'Bar'); |
96 | |
97 | can_ok($bar, 'foo'); |
98 | can_ok($bar, 'has_foo'); |
99 | can_ok($bar, 'get_bar'); |
100 | can_ok($bar, 'set_bar'); |
101 | |
102 | ok($bar->has_foo, '... Bar::has_foo == 1'); |
103 | ok($bar->SUPER_has_foo, '... Bar::SUPER_has_foo == 1'); |
104 | |
105 | is($bar->foo, 'Bar::foo', '... got the right default value for Bar::foo'); |
106 | is($bar->SUPER_foo(), 'Foo::foo', '... got the right default value for Bar::SUPER::foo'); |
107 | } |
108 | |
109 | done_testing; |