t/accessor-weaken.t

   1 use strictures 1;
   2 use Test::More;
   3
   4 {
   5   package Foo;
   6
   7   use Moo;
   8
   9   has one => (is => 'rw', weak_ref => 1);
  10
  11   package Foo2;
  12
  13   use Moo;
  14
  15   has one => (is => 'rw', lazy => 1, weak_ref => 1, default => sub { {} });
  16 }
  17
  18 my $ref = {};
  19 my $foo = Foo->new(one => $ref);
  20 is($foo->one, $ref, 'value present');
  21 ok(Scalar::Util::isweak($foo->{one}), 'value weakened');
  22 is($foo->one($ref), $ref, 'value returned from setter');
  23 undef $ref;
  24 ok(!defined $foo->{one}, 'weak value gone');
  25
  26 my $foo2 = Foo2->new;
  27 ok(my $ref2 = $foo2->one, 'value returned');
  28 ok(Scalar::Util::isweak($foo2->{one}), 'value weakened');
  29 is($foo2->one($ref2), $ref2, 'value returned from setter');
  30 undef $ref2;
  31 ok(!defined $foo->{one}, 'weak value gone');
  32
  33
  34 # test readonly SVs
  35 sub mk_ref { \ 'yay' };
  36 my $foo_ro = eval { Foo->new(one => mk_ref()) };
  37 if ($] < 5.008003) {
  38   like(
  39     $@,
  40     qr/\QReference to readonly value in "one" can not be weakened on Perl < 5.8.3/,
  41     'Expected exception thrown on old perls'
  42   );
  43 }
  44 elsif ($^O eq 'cygwin' and $] < 5.012000) {
  45   SKIP: { skip 'Static coderef reaping seems nonfunctional on cygwin < 5.12', 1 }
  46 }
  47 else {
  48   is(${$foo_ro->one},'yay', 'value present');
  49   ok(Scalar::Util::isweak($foo_ro->{one}), 'value weakened');
  50
  51   { no warnings 'redefine'; *mk_ref = sub {} }
  52   ok (!defined $foo_ro->{one}, 'optree reaped, ro static value gone');
  53 }
  54
  55 done_testing;