4 use Scalar::Util qw(weaken);
9 my @names = qw(one two);
13 foreach my $idx (-1 .. $#names-1) {
14 $next_name{$names[$idx+1]} = $names[$idx];
17 my %last_name = reverse %next_name;
21 foreach my $name (@names) {
22 weaken($weak{$name} = $real{$name} = bless({}, 'Foo'));
25 # setup forward and back pointers
27 foreach my $name (@names) {
28 $real{$name}->{forward} = $real{$next_name{$name}};
29 weaken($real{$next_name{$name}->{back} = $real{$name});
32 # weaken last forward pointer
34 weaken($real{$names[-1]}->{forward});
36 # to test: undef each one in order
38 # undef all and verify destruction
42 @weak{qw(one two)} = @real{qw(one two)} = ({}, {});
44 weaken($_) for values %weak;
46 $real{one}->{two} = $real{two};
48 $real{two}->{one} = $real{one};
50 delete @real{keys %real};
53 (scalar grep defined, values %weak), '==', 0,
54 'All objects destroyed now'