notes/flip-flop.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Scalar::Util qw(weaken isweak);
   6
   7 # $X strong -> $Y
   8 # $Y weak   -> $X
   9 #
  10 # $Y goes out of scope - all fine
  11 #
  12 # $X goes out of scope - need to swap to
  13 #
  14 # $X weak   -> $Y
  15 # $Y strong -> $X
  16 #
  17 # but not if $Y is already out of scope - so don't do it unless $Y's refcount
  18 # is >1
  19
  20 BEGIN {
  21   package Foo;
  22
  23   use Devel::GlobalDestruction 'in_global_destruction';
  24   use Scalar::Util qw(weaken isweak);
  25   use Devel::Refcount qw(refcount);
  26
  27   sub DESTROY {
  28     my $self = shift;
  29     warn "DESTROY fired for $self\n";
  30     return if in_global_destruction;
  31     warn "Not in global destruction\n";
  32     return unless isweak $self->{back}{forward};
  33     warn "Reference to us is weak\n";
  34     return unless $self->{forward};
  35     warn "Have forward pointer\n";
  36     return unless refcount($self->{forward}) > 1;
  37     warn "Next in chain has refcount of ".(refcount $self->{forward})."\n";
  38     $self->{back}{forward} = $self; #->{back}{forward};
  39     weaken $self->{forward};
  40     warn "Swapped links - $self now has weak ref to ${\$self->{forward}} and ${\$self->{back}} has a strong ref to $self\n";
  41     return;
  42   }
  43 }
  44
  45 # set this shit up
  46 my $one = bless({}, 'Foo');
  47 my $two = bless({}, 'Foo');
  48 weaken(my $weak_one = $one);
  49 weaken(my $weak_two = $two);
  50 $one->{forward} = $two;
  51 weaken($two->{forward} = $one);
  52 weaken($one->{back} = $two);
  53 weaken($two->{back} = $one);
  54
  55 sub status {
  56   warn "One: ${\($weak_one||'GONE')} Two: ${\($weak_two||'GONE')}\n";
  57   warn "One's forward is${\(isweak($weak_one->{forward}) ? '' : ' not')} weak\n" if $weak_one;
  58   warn "Two's forward is${\(isweak($weak_two->{forward}) ? '' : ' not')} weak\n" if $weak_two;
  59 }
  60
  61 warn "\$one is $one, \$two is $two";
  62 warn "Undefining \$two\n";
  63 undef($two);
  64 status;
  65 warn "Restoring \$two\n";
  66 $two = $weak_two;
  67 warn "Undefining \$one\n";
  68 undef($one);
  69 status;
  70 warn "Restoring \$one\n";
  71 $one = $weak_one;
  72 warn "Undefining \$two\n";
  73 undef($two);
  74 status;
  75 warn "Restoring \$two\n";
  76 $two = $weak_two;
  77 warn "Undefining both\n";
  78 undef($one);
  79 undef($two);
  80 status;
  81 warn "Done\n";