Commit | Line | Data |
b04e9927 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
4 | |
5 | { |
6 | package Foo; |
7 | use Moose; |
8 | |
9 | has bar => ( |
10 | is => 'ro', |
11 | weak_ref => 1, |
12 | ); |
13 | } |
14 | |
15 | { |
16 | package MyScopeGuard; |
17 | |
18 | sub new { |
19 | my ($class, $cb) = @_; |
20 | bless { cb => $cb }, $class; |
21 | } |
22 | |
23 | sub DESTROY { shift->{cb}->() } |
24 | } |
25 | |
26 | { |
27 | my $destroyed = 0; |
28 | |
29 | my $foo = do { |
30 | my $bar = MyScopeGuard->new(sub { $destroyed++ }); |
31 | my $foo = Foo->new({ bar => $bar }); |
32 | my $clone = $foo->meta->clone_object($foo); |
33 | |
34 | is $destroyed, 0; |
35 | |
36 | $clone; |
37 | }; |
38 | |
39 | isa_ok($foo, 'Foo'); |
40 | is $foo->bar, undef; |
41 | is $destroyed, 1; |
42 | } |
43 | |
ec118926 |
44 | { |
45 | my $clone; |
46 | { |
47 | my $anon = Moose::Meta::Class->create_anon_class; |
48 | |
49 | my $foo = $anon->new_object; |
50 | isa_ok($foo, $anon->name); |
51 | ok(Class::MOP::class_of($foo), "has a metaclass"); |
52 | |
53 | $clone = $anon->clone_object($foo); |
54 | isa_ok($clone, $anon->name); |
55 | ok(Class::MOP::class_of($clone), "has a metaclass"); |
56 | } |
57 | |
58 | ok(Class::MOP::class_of($clone), "still has a metaclass"); |
59 | } |
60 | |
61 | { |
62 | package Foo::Meta::Attr::Trait; |
63 | use Moose::Role; |
64 | |
65 | has value_slot => ( |
66 | is => 'ro', |
67 | isa => 'Str', |
68 | lazy => 1, |
69 | default => sub { shift->name }, |
70 | ); |
71 | |
72 | has count_slot => ( |
73 | is => 'ro', |
74 | isa => 'Str', |
75 | lazy => 1, |
76 | default => sub { '<<COUNT>>' . shift->name }, |
77 | ); |
78 | |
79 | sub slots { |
80 | my $self = shift; |
81 | return ($self->value_slot, $self->count_slot); |
82 | } |
83 | |
84 | sub _set_count { |
85 | my $self = shift; |
86 | my ($instance) = @_; |
87 | my $mi = $self->associated_class->get_meta_instance; |
88 | $mi->set_slot_value( |
89 | $instance, |
90 | $self->count_slot, |
91 | ($mi->get_slot_value($instance, $self->count_slot) || 0) + 1, |
92 | ); |
93 | } |
94 | |
95 | sub _clear_count { |
96 | my $self = shift; |
97 | my ($instance) = @_; |
98 | $self->associated_class->get_meta_instance->deinitialize_slot( |
99 | $instance, $self->count_slot |
100 | ); |
101 | } |
102 | |
103 | sub has_count { |
104 | my $self = shift; |
105 | my ($instance) = @_; |
106 | $self->associated_class->get_meta_instance->has_slot_value( |
107 | $instance, $self->count_slot |
108 | ); |
109 | } |
110 | |
111 | sub count { |
112 | my $self = shift; |
113 | my ($instance) = @_; |
114 | $self->associated_class->get_meta_instance->get_slot_value( |
115 | $instance, $self->count_slot |
116 | ); |
117 | } |
118 | |
119 | after set_initial_value => sub { |
120 | shift->_set_count(@_); |
121 | }; |
122 | |
123 | after set_value => sub { |
124 | shift->_set_count(@_); |
125 | }; |
126 | |
127 | around _inline_instance_set => sub { |
128 | my $orig = shift; |
129 | my $self = shift; |
130 | my ($instance) = @_; |
131 | |
132 | my $mi = $self->associated_class->get_meta_instance; |
133 | |
134 | return 'do { ' |
135 | . $mi->inline_set_slot_value( |
136 | $instance, |
137 | $self->count_slot, |
138 | $mi->inline_get_slot_value( |
139 | $instance, $self->count_slot |
140 | ) . ' + 1' |
141 | ) . ';' |
142 | . $self->$orig(@_) |
143 | . '}'; |
144 | }; |
145 | |
146 | after clear_value => sub { |
147 | shift->_clear_count(@_); |
148 | }; |
149 | } |
150 | |
151 | { |
152 | package Bar; |
153 | use Moose; |
154 | Moose::Util::MetaRole::apply_metaroles( |
155 | for => __PACKAGE__, |
156 | class_metaroles => { |
157 | attribute => ['Foo::Meta::Attr::Trait'], |
158 | }, |
159 | ); |
160 | |
161 | has baz => ( is => 'rw' ); |
162 | } |
163 | |
164 | { |
165 | my $attr = Bar->meta->find_attribute_by_name('baz'); |
166 | |
167 | my $bar = Bar->new(baz => 1); |
168 | is($attr->count($bar), 1, "right count"); |
169 | |
170 | $bar->baz(2); |
171 | is($attr->count($bar), 2, "right count"); |
172 | |
173 | my $clone = $bar->meta->clone_object($bar); |
174 | is($attr->count($clone), $attr->count($bar), "right count"); |
175 | } |
176 | |
b04e9927 |
177 | done_testing; |