Commit | Line | Data |
2bab2be6 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
efd3d14c |
6 | use Test::More tests => 45; |
2bab2be6 |
7 | use Test::Exception; |
8 | |
5582521c |
9 | use Scalar::Util qw/isweak reftype/; |
10 | |
efd3d14c |
11 | use Class::MOP::Instance; |
2bab2be6 |
12 | |
de943e6a |
13 | can_ok( "Class::MOP::Instance", $_ ) for qw/ |
f2fd2f40 |
14 | new |
15 | |
16 | create_instance |
17 | bless_instance_structure |
de943e6a |
18 | |
49c93440 |
19 | get_all_slots |
f2fd2f40 |
20 | |
21 | initialize_all_slots |
22 | deinitialize_all_slots |
23 | |
24 | get_slot_value |
25 | set_slot_value |
26 | initialize_slot |
27 | deinitialize_slot |
28 | is_slot_initialized |
29 | weaken_slot_value |
30 | strengthen_slot_value |
31 | |
32 | inline_get_slot_value |
33 | inline_set_slot_value |
34 | inline_initialize_slot |
35 | inline_deinitialize_slot |
36 | inline_is_slot_initialized |
37 | inline_weaken_slot_value |
38 | inline_strengthen_slot_value |
de943e6a |
39 | /; |
40 | |
41 | { |
f2fd2f40 |
42 | package Foo; |
43 | use metaclass; |
44 | |
45 | Foo->meta->add_attribute('moosen'); |
de943e6a |
46 | |
f2fd2f40 |
47 | package Bar; |
48 | use metaclass; |
49 | use base qw/Foo/; |
de943e6a |
50 | |
f2fd2f40 |
51 | Bar->meta->add_attribute('elken'); |
49c93440 |
52 | } |
de943e6a |
53 | |
49c93440 |
54 | my $mi_foo = Foo->meta->get_meta_instance; |
55 | isa_ok($mi_foo, "Class::MOP::Instance"); |
de943e6a |
56 | |
49c93440 |
57 | is_deeply( |
f2fd2f40 |
58 | [ $mi_foo->get_all_slots ], |
59 | [ "moosen" ], |
49c93440 |
60 | '... get all slots for Foo'); |
de943e6a |
61 | |
62 | my $mi_bar = Bar->meta->get_meta_instance; |
49c93440 |
63 | isa_ok($mi_bar, "Class::MOP::Instance"); |
de943e6a |
64 | |
49c93440 |
65 | isnt($mi_foo, $mi_bar, '... they are not the same instance'); |
de943e6a |
66 | |
49c93440 |
67 | is_deeply( |
f2fd2f40 |
68 | [ sort $mi_bar->get_all_slots ], |
69 | [ "elken", "moosen" ], |
49c93440 |
70 | '... get all slots for Bar'); |
de943e6a |
71 | |
49c93440 |
72 | my $i_foo = $mi_foo->create_instance; |
73 | isa_ok($i_foo, "Foo"); |
de943e6a |
74 | |
49c93440 |
75 | { |
76 | my $i_foo_2 = $mi_foo->create_instance; |
f2fd2f40 |
77 | isa_ok($i_foo_2, "Foo"); |
49c93440 |
78 | isnt($i_foo_2, $i_foo, '... not the same instance'); |
79 | is_deeply($i_foo, $i_foo_2, '... but the same structure'); |
80 | } |
de943e6a |
81 | |
7d28758b |
82 | ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot not initialized"); |
83 | |
49c93440 |
84 | ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot"); |
de943e6a |
85 | |
7d28758b |
86 | $mi_foo->initialize_slot( $i_foo, "moosen" ); |
87 | |
f2fd2f40 |
88 | #Removed becayse slot initialization works differently now (groditi) |
89 | #ok($mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot initialized"); |
7d28758b |
90 | |
91 | ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... but no value for slot"); |
92 | |
de943e6a |
93 | $mi_foo->set_slot_value( $i_foo, "moosen", "the value" ); |
94 | |
49c93440 |
95 | is($mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "... get slot value"); |
49c93440 |
96 | ok(!$i_foo->can('moosen'), '... Foo cant moosen'); |
5582521c |
97 | |
5582521c |
98 | my $ref = []; |
5582521c |
99 | |
ee7c0467 |
100 | $mi_foo->set_slot_value( $i_foo, "moosen", $ref ); |
101 | $mi_foo->weaken_slot_value( $i_foo, "moosen" ); |
5582521c |
102 | |
ee7c0467 |
103 | ok( isweak($i_foo->{moosen}), '... white box test of weaken' ); |
104 | is( $mi_foo->get_slot_value( $i_foo, "moosen" ), $ref, "weak value is fetchable" ); |
5582521c |
105 | ok( !isweak($mi_foo->get_slot_value( $i_foo, "moosen" )), "return value not weak" ); |
106 | |
107 | undef $ref; |
108 | |
109 | is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" ); |
110 | |
111 | $ref = []; |
112 | |
113 | $mi_foo->set_slot_value( $i_foo, "moosen", $ref ); |
114 | |
115 | undef $ref; |
116 | |
117 | is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "value not weak yet" ); |
118 | |
119 | $mi_foo->weaken_slot_value( $i_foo, "moosen" ); |
120 | |
121 | is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" ); |
122 | |
5582521c |
123 | $ref = []; |
124 | |
125 | $mi_foo->set_slot_value( $i_foo, "moosen", $ref ); |
5582521c |
126 | $mi_foo->weaken_slot_value( $i_foo, "moosen" ); |
ee7c0467 |
127 | ok( isweak($i_foo->{moosen}), '... white box test of weaken' ); |
5582521c |
128 | $mi_foo->strengthen_slot_value( $i_foo, "moosen" ); |
ee7c0467 |
129 | ok( !isweak($i_foo->{moosen}), '... white box test of weaken' ); |
5582521c |
130 | |
131 | undef $ref; |
132 | |
133 | is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "weak value can be strengthened" ); |
134 | |
7d28758b |
135 | $mi_foo->deinitialize_slot( $i_foo, "moosen" ); |
136 | |
137 | ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot deinitialized"); |
138 | |
139 | ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot"); |
140 | |