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