Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
cacfab6c |
4 | |
5 | use Test::More; |
6 | BEGIN { |
7 | if (eval "require Scalar::Util; 1") { |
8 | plan tests => 21; |
9 | } |
10 | else { |
11 | plan skip_all => "Scalar::Util required for this test"; |
12 | } |
13 | } |
14 | |
8c831d08 |
15 | use Mouse::Util ':test'; |
c3398f5b |
16 | |
17 | my %destroyed; |
18 | |
19 | do { |
20 | do { |
21 | package Class; |
22 | use Mouse; |
23 | |
24 | has self => ( |
25 | is => 'rw', |
26 | weak_ref => 1, |
27 | ); |
28 | |
29 | has type => ( |
30 | is => 'rw', |
31 | ); |
32 | |
33 | sub DEMOLISH { |
34 | my $self = shift; |
35 | $destroyed{ $self->type }++; |
36 | } |
37 | }; |
38 | |
39 | my $self = Class->new(type => 'accessor'); |
40 | $self->self($self); |
41 | |
42 | my $self2 = Class->new(type => 'middle'); |
43 | my $self3 = Class->new(type => 'constructor', self => $self2); |
44 | $self2->self($self3); |
45 | |
46 | for my $object ($self, $self2, $self3) { |
cacfab6c |
47 | ok(Scalar::Util::isweak($object->{self}), "weak reference"); |
c3398f5b |
48 | ok($object->self->self->self->self, "we've got circularity"); |
49 | } |
50 | }; |
51 | |
52 | is($destroyed{accessor}, 1, "destroyed from the accessor"); |
53 | is($destroyed{constructor}, 1, "destroyed from the constructor"); |
54 | is($destroyed{middle}, 1, "casuality of war"); |
55 | |
3645b316 |
56 | ok(!Class->meta->get_attribute('type')->is_weak_ref, "type is not a weakref"); |
57 | ok(Class->meta->get_attribute('self')->is_weak_ref, "self IS a weakref"); |
c3398f5b |
58 | |
59 | do { |
60 | package Class2; |
61 | use Mouse; |
62 | |
63 | has value => ( |
3645b316 |
64 | is => 'rw', |
c3398f5b |
65 | default => 10, |
66 | weak_ref => 1, |
67 | ); |
68 | }; |
69 | |
3645b316 |
70 | ok(Class2->meta->get_attribute('value')->is_weak_ref, "value IS a weakref"); |
71 | |
72 | lives_ok { |
73 | my $obj = Class2->new; |
74 | is($obj->value, 10, "weak_ref doesn't apply to non-refs"); |
75 | }; |
76 | |
77 | my $obj2 = Class2->new; |
78 | lives_ok { |
79 | $obj2->value({}); |
80 | }; |
81 | |
82 | is_deeply($obj2->value, undef, "weakened the reference even with a nonref default"); |
c3398f5b |
83 | |
84 | do { |
85 | package Class3; |
86 | use Mouse; |
87 | |
88 | has hashref => ( |
e6ac69d4 |
89 | is => 'rw', |
c3398f5b |
90 | default => sub { {} }, |
91 | weak_ref => 1, |
92 | predicate => 'has_hashref', |
93 | ); |
94 | }; |
95 | |
96 | my $obj = Class3->new; |
97 | is($obj->hashref, undef, "hashref collected immediately because refcount=0"); |
98 | ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance'); |
99 | |
100 | $obj->hashref({1 => 1}); |
101 | is($obj->hashref, undef, "hashref collected between set and get because refcount=0"); |
102 | ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance'); |
103 | |
3645b316 |
104 | ok(Class3->meta->get_attribute('hashref')->is_weak_ref, "hashref IS a weakref"); |