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