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