Move t/*/t into t/001_mouse

[gitmo/Mouse.git] / t / 001_mouse / 021-weak-ref.t

diff --git a/t/001_mouse/021-weak-ref.t b/t/001_mouse/021-weak-ref.t
new file mode 100644 (file)
index 0000000..3f054c9
--- /dev/null
+++ b/t/001_mouse/021-weak-ref.t
@@ -0,0 +1,108 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More tests => 31;
+use Test::Exception;
+
+my %destroyed;
+
+do {
+    do {
+        package Class;
+        use Mouse;
+
+        has self => (
+            is       => 'rw',
+            weak_ref => 1,
+        );
+
+        has type => (
+            is => 'rw',
+        );
+
+        sub DEMOLISH {
+            my $self = shift;
+            $destroyed{ $self->type }++;
+        }
+    };
+};
+
+sub do_test{
+    my $self = Class->new(type => 'accessor');
+    $self->self($self);
+
+    my $self2 = Class->new(type => 'middle');
+    my $self3 = Class->new(type => 'constructor', self => $self2);
+    $self2->self($self3);
+
+    for my $object ($self, $self2, $self3) {
+        ok(Scalar::Util::isweak($object->{self}), "weak reference");
+        ok($object->self->self->self->self, "we've got circularity");
+    }
+}
+
+do_test();
+
+is($destroyed{accessor}, 1, "destroyed from the accessor");
+is($destroyed{constructor}, 1, "destroyed from the constructor");
+is($destroyed{middle}, 1, "casuality of war");
+
+Class->meta->make_immutable();
+ok(Class->meta->is_immutable, 'make_immutable made it immutable');
+do_test();
+
+is($destroyed{accessor}, 2, "destroyed from the accessor (after make_immutable)");
+is($destroyed{constructor}, 2, "destroyed from the constructor (after make_immutable)");
+is($destroyed{middle}, 2, "casuality of war (after make_immutable)");
+
+
+ok(!Class->meta->get_attribute('type')->is_weak_ref, "type is not a weakref");
+ok(Class->meta->get_attribute('self')->is_weak_ref, "self IS a weakref");
+
+do {
+    package Class2;
+    use Mouse;
+
+    has value => (
+        is => 'rw',
+        default => 10,
+        weak_ref => 1,
+    );
+};
+
+ok(Class2->meta->get_attribute('value')->is_weak_ref, "value IS a weakref");
+
+lives_ok {
+    my $obj = Class2->new;
+    is($obj->value, 10, "weak_ref doesn't apply to non-refs");
+};
+
+my $obj2 = Class2->new;
+lives_ok {
+    $obj2->value({});
+};
+
+is_deeply($obj2->value, undef, "weakened the reference even with a nonref default");
+
+do {
+    package Class3;
+    use Mouse;
+
+    has hashref => (
+        is        => 'rw',
+        default   => sub { {} },
+        weak_ref  => 1,
+        predicate => 'has_hashref',
+    );
+};
+
+my $obj = Class3->new;
+is($obj->hashref, undef, "hashref collected immediately because refcount=0");
+ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance');
+
+$obj->hashref({1 => 1});
+is($obj->hashref, undef, "hashref collected between set and get because refcount=0");
+ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance');
+
+ok(Class3->meta->get_attribute('hashref')->is_weak_ref, "hashref IS a weakref");