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