From: Matt S Trout <matthewt@hercule.scsys.co.uk>
Date: Mon, 15 Jun 2009 21:20:31 +0000 (+0100)
Subject: demonstrate that perl's GC is smarter than I am and that weakening in the get doesn... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=093a8e73a6dc80dadae05636869caf95f9e23d04;p=p5sagit%2FMutually-Assured-Destruction.git

demonstrate that perl's GC is smarter than I am and that weakening in the get doesn't actually work
---

diff --git a/notes/strong-and-weak.pl b/notes/strong-and-weak.pl
new file mode 100644
index 0000000..cb0ff34
--- /dev/null
+++ b/notes/strong-and-weak.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Devel::GlobalDestruction ();
+use Scalar::Util ();
+use Variable::Magic ();
+use Carp ();
+
+BEGIN {
+  package Foo;
+
+  my $wiz;
+  $wiz = Variable::Magic::wizard
+    data => sub { $_[1] },
+    get => sub {
+      Carp::cluck "get fired";
+      Scalar::Util::weaken($_[1]->{reference}{other_side} = ${$_[0]});
+      Scalar::Util::weaken($_[1]->{reference});
+      Variable::Magic::dispell ${$_[0]}, $wiz;
+    };
+
+  sub DESTROY {
+    return if Devel::GlobalDestruction::in_global_destruction();
+    Carp::cluck "DESTROY\n";
+
+    my $self = shift;
+
+    if (ref $self->{other_side} && $self->{other_side}{reference}) {
+      if (
+        Scalar::Util::refaddr($self->{other_side}{reference})
+        eq Scalar::Util::refaddr($self)
+      ) {
+        warn "Enlivening";
+        $self->{other_side}{reference} = $self;
+        Variable::Magic::cast(
+          $self->{other_side}{reference}, $wiz, $self->{other_side}
+        );
+        delete $self->{other_side};
+      }
+    }
+  }
+}
+
+my $near = {};
+my $far = $near->{reference} = bless({ other_side => $near }, 'Foo');
+warn $near->{reference};
+warn $far;
+Scalar::Util::weaken($near->{reference});
+warn "Setup done\n";
+undef($far);
+my $copy = $near->{reference};
+warn $copy;
+warn Scalar::Util::isweak($near->{reference});
+warn $near->{reference};
+warn $near->{reference};
+undef($near);
+warn "Done\n";