t/01simple.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Scalar::Util qw(weaken);
   5
   6 my %real;
   7 my %weak;
   8
   9 my @names = qw(one two);
  10
  11 my %next_name;
  12
  13 foreach my $idx (-1 .. $#names-1) {
  14   $next_name{$names[$idx+1]} = $names[$idx];
  15 }
  16
  17 my %last_name = reverse %next_name;
  18
  19 # construct objects
  20
  21 foreach my $name (@names) {
  22   weaken($weak{$name} = $real{$name} = bless({}, 'Foo'));
  23 }
  24
  25 # setup forward and back pointers
  26
  27 foreach my $name (@names) {
  28   $real{$name}->{forward} = $real{$next_name{$name}};
  29   weaken($real{$next_name{$name}->{back} = $real{$name});
  30 }
  31
  32 # weaken last forward pointer
  33
  34 weaken($real{$names[-1]}->{forward});
  35
  36 # to test: undef each one in order
  37 #          undef all but one
  38 #          undef all and verify destruction
  39
  40
  41
  42 @weak{qw(one two)} = @real{qw(one two)} = ({}, {});
  43
  44 weaken($_) for values %weak;
  45
  46 $real{one}->{two} = $real{two};
  47
  48 $real{two}->{one} = $real{one};
  49
  50 delete @real{keys %real};
  51
  52 cmp_ok(
  53   (scalar grep defined, values %weak), '==', 0,
  54   'All objects destroyed now'
  55 );
  56
  57 done_testing;