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");