t/021-weak-ref.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 21;
   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
  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");
  49
  50 do {
  51     package Class2;
  52     use Mouse;
  53
  54     has value => (
  55         is => 'rw',
  56         default => 10,
  57         weak_ref => 1,
  58     );
  59 };
  60
  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");
  74
  75 do {
  76     package Class3;
  77     use Mouse;
  78
  79     has hashref => (
  80         is        => 'rw',
  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
  95 ok(Class3->meta->get_attribute('hashref')->is_weak_ref, "hashref IS a weakref");