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 => 'ro', weak_ref => 1);
  10 }
  11
  12 my $ref = {};
  13 my $foo = Foo->new(one => $ref);
  14 is($foo->one, $ref, 'value present');
  15 ok(Scalar::Util::isweak($foo->{one}), 'value weakened');
  16 undef $ref;
  17 ok (!defined $foo->{one}, 'weak value gone');
  18
  19 # test readonly SVs
  20 sub mk_ref { \ 'yay' };
  21 my $foo_ro = eval { Foo->new(one => mk_ref()) };
  22 if ($] < 5.008003) {
  23   like(
  24     $@,
  25     qr/\QReference to readonly value in "one" can not be weakened on Perl < 5.8.3/,
  26     'Expected exception thrown on old perls'
  27   );
  28 }
  29 else {
  30   is(${$foo_ro->one},'yay', 'value present');
  31   ok(Scalar::Util::isweak($foo_ro->{one}), 'value weakened');
  32
  33   { no warnings 'redefine'; *mk_ref = sub {} }
  34   ok (!defined $foo_ro->{one}, 'optree reaped, ro static value gone');
  35 }
  36
  37 done_testing;