Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
3645b316 |
4 | use Test::More tests => 21; |
c3398f5b |
5 | use Test::Exception; |
6 | use Scalar::Util 'isweak'; |
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 | }; |
29 | |
30 | my $self = Class->new(type => 'accessor'); |
31 | $self->self($self); |
32 | |
33 | my $self2 = Class->new(type => 'middle'); |
34 | my $self3 = Class->new(type => 'constructor', self => $self2); |
35 | $self2->self($self3); |
36 | |
37 | for my $object ($self, $self2, $self3) { |
38 | ok(isweak($object->{self}), "weak reference"); |
39 | ok($object->self->self->self->self, "we've got circularity"); |
40 | } |
41 | }; |
42 | |
43 | is($destroyed{accessor}, 1, "destroyed from the accessor"); |
44 | is($destroyed{constructor}, 1, "destroyed from the constructor"); |
45 | is($destroyed{middle}, 1, "casuality of war"); |
46 | |
3645b316 |
47 | ok(!Class->meta->get_attribute('type')->is_weak_ref, "type is not a weakref"); |
48 | ok(Class->meta->get_attribute('self')->is_weak_ref, "self IS a weakref"); |
c3398f5b |
49 | |
50 | do { |
51 | package Class2; |
52 | use Mouse; |
53 | |
54 | has value => ( |
3645b316 |
55 | is => 'rw', |
c3398f5b |
56 | default => 10, |
57 | weak_ref => 1, |
58 | ); |
59 | }; |
60 | |
3645b316 |
61 | ok(Class2->meta->get_attribute('value')->is_weak_ref, "value IS a weakref"); |
62 | |
63 | lives_ok { |
64 | my $obj = Class2->new; |
65 | is($obj->value, 10, "weak_ref doesn't apply to non-refs"); |
66 | }; |
67 | |
68 | my $obj2 = Class2->new; |
69 | lives_ok { |
70 | $obj2->value({}); |
71 | }; |
72 | |
73 | is_deeply($obj2->value, undef, "weakened the reference even with a nonref default"); |
c3398f5b |
74 | |
75 | do { |
76 | package Class3; |
77 | use Mouse; |
78 | |
79 | has hashref => ( |
e6ac69d4 |
80 | is => 'rw', |
c3398f5b |
81 | default => sub { {} }, |
82 | weak_ref => 1, |
83 | predicate => 'has_hashref', |
84 | ); |
85 | }; |
86 | |
87 | my $obj = Class3->new; |
88 | is($obj->hashref, undef, "hashref collected immediately because refcount=0"); |
89 | ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance'); |
90 | |
91 | $obj->hashref({1 => 1}); |
92 | is($obj->hashref, undef, "hashref collected between set and get because refcount=0"); |
93 | ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance'); |
94 | |
3645b316 |
95 | ok(Class3->meta->get_attribute('hashref')->is_weak_ref, "hashref IS a weakref"); |