Make anonymous classes work correctly
[gitmo/Mouse.git] / t / 021-weak-ref.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
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
15 use Test::Exception;
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) {
47         ok(Scalar::Util::isweak($object->{self}), "weak reference");
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
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");
58
59 do {
60     package Class2;
61     use Mouse;
62
63     has value => (
64         is => 'rw',
65         default => 10,
66         weak_ref => 1,
67     );
68 };
69
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");
83
84 do {
85     package Class3;
86     use Mouse;
87
88     has hashref => (
89         is        => 'rw',
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
104 ok(Class3->meta->get_attribute('hashref')->is_weak_ref, "hashref IS a weakref");