t/021-weak-ref.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 18;
   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')->weak_ref, "type is not a weakref");
  48 ok(Class->meta->get_attribute('self')->weak_ref, "self IS a weakref");
  49
  50 do {
  51     package Class2;
  52     use Mouse;
  53
  54     has value => (
  55         is => 'ro',
  56         default => 10,
  57         weak_ref => 1,
  58     );
  59 };
  60
  61 throws_ok { Class2->new } qr/Can't weaken a nonreference/;
  62 ok(Class2->meta->get_attribute('value')->weak_ref, "value IS a weakref");
  63
  64 do {
  65     package Class3;
  66     use Mouse;
  67
  68     has hashref => (
  69         is        => 'ro',
  70         default   => sub { {} },
  71         weak_ref  => 1,
  72         predicate => 'has_hashref',
  73     );
  74 };
  75
  76 my $obj = Class3->new;
  77 is($obj->hashref, undef, "hashref collected immediately because refcount=0");
  78 ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance');
  79
  80 $obj->hashref({1 => 1});
  81 is($obj->hashref, undef, "hashref collected between set and get because refcount=0");
  82 ok($obj->has_hashref, 'attribute is turned into undef, not deleted from instance');
  83
  84 ok(Class3->meta->get_attribute('hashref')->weak_ref, "hashref IS a weakref");