Skip to content

Instantly share code, notes, and snippets.

@stevan
Created July 15, 2013 01:56
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save stevan/769f6b52ca2338f24841 to your computer and use it in GitHub Desktop.
#!perl
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Scalar::Util qw[ weaken isweak ];
use mop;
class WeakAttribute extends mop::attribute {
method store_data_in_slot_for ($instance, $data) {
$self->next::method( $instance, $data );
warn "STORAGE: " . $self->storage;
warn "INSTANCE: " . $instance;
warn "VALUE: " . $self->storage->{ $instance };
weaken ${ $self->storage->{ $instance } };
}
}
sub weak {
my $meta = shift;
my %args = @_;
if (exists $args{'attribute'}) {
my ($name) = @{ $args{'attribute'} };
my $attr = $meta->get_attribute($name);
# this is kinda ugly here ...
$meta->add_attribute(WeakAttribute->new(
name => $attr->name,
default => $attr->default,
storage => $attr->storage
));
}
}
class Foo {
has $bar is rw;
submethod DEMOLISH {
warn "reapin... "
}
}
class Bar {
# YUK!
# order of trait application
# matters, this fails if the
# rw trait is applied first
# cause the rw trait uses the
# attribute object in a closure
# - SL
has $foo is weak, rw;
}
my $foo = Foo->new;
my $bar = Bar->new;
$bar->foo($foo);
$foo->bar($bar);
my $store = mop::get_meta('Bar')->get_attribute('$foo')->storage;
warn "STORAGE: " . $store;
warn "INSTANCE: " . $bar;
warn "VALUE: " . $store->{ $bar };
my $x = $store->{ $bar };
ok(isweak($$x), '... this is weak');
warn $foo->bar;
is($foo->bar, $bar, '... these match');
is($bar->foo, $foo, '... these match');
undef $foo;
is($bar->foo, undef, '... weak ref reaped');
done_testing;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment