From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sat, 29 Apr 2006 17:20:51 +0000 (+0000)
Subject: Add support for weak references to Class::MOP::Instance
X-Git-Tag: 0_29_02~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5582521c4970098c583a45319498f81598ed77a0;p=gitmo%2FClass-MOP.git

Add support for weak references to Class::MOP::Instance
---

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index 79f310b..f79c063 100644
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -78,6 +78,22 @@ sub is_slot_initialized {
     exists $instance->{$slot_name} ? 1 : 0;
 }
 
+sub set_slot_value_weak {
+    my ($self, $instance, $slot_name, $value) = @_;
+	$self->set_slot_value($instance, $slot_name, $value);
+	$self->weaken_slot_value($instance, $slot_name);
+}
+
+sub weaken_slot_value {
+	my ($self, $instance, $slot_name) = @_;
+	weaken $instance->{$slot_name};
+}
+
+sub strengthen_slot_value {
+	my ($self, $instance, $slot_name) = @_;
+	$self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
+}
+
 1;
 
 __END__
@@ -181,6 +197,12 @@ require that the C<$instance_structure> is passed into them.
 
 =item B<is_slot_initialized ($instance_structure, $slot_name)>
 
+=item B<set_slot_value_weak ($instance_structure, $slot_name, $ref_value)>
+
+=item B<weaken_slot_value>
+
+=item B<strengthen_slot_value>
+
 =back
 
 =head1 AUTHOR
@@ -199,3 +221,4 @@ This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
 =cut
+
diff --git a/t/060_instance.t b/t/060_instance.t
index 45961cd..579cc59 100644
--- a/t/060_instance.t
+++ b/t/060_instance.t
@@ -3,9 +3,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 22;
+use Test::More 'no_plan';
 use Test::Exception;
 
+use Scalar::Util qw/isweak reftype/;
+
 BEGIN {
     use_ok('Class::MOP::Instance');    
 }
@@ -73,3 +75,44 @@ $mi_foo->set_slot_value( $i_foo, "moosen", "the value" );
 is($mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "... get slot value");
 
 ok(!$i_foo->can('moosen'), '... Foo cant moosen');
+
+can_ok( $mi_foo, "set_slot_value_weak" );
+
+my $ref = [];
+$mi_foo->set_slot_value_weak( $i_foo, "moosen", $ref );
+
+is( $mi_foo->get_slot_value( $i_foo, "moosen" ), $ref, "weak value is fetchable" );
+
+ok( !isweak($mi_foo->get_slot_value( $i_foo, "moosen" )), "return value not weak" );
+
+undef $ref;
+
+is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" );
+
+$ref = [];
+
+$mi_foo->set_slot_value( $i_foo, "moosen", $ref );
+
+undef $ref;
+
+is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "value not weak yet" );
+
+$mi_foo->weaken_slot_value( $i_foo, "moosen" );
+
+is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" );
+
+
+$ref = [];
+
+$mi_foo->set_slot_value( $i_foo, "moosen", $ref );
+
+
+$mi_foo->weaken_slot_value( $i_foo, "moosen" );
+
+$mi_foo->strengthen_slot_value( $i_foo, "moosen" );
+
+undef $ref;
+
+is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "weak value can be strengthened" );
+
+