-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 30;
+use Test::More tests => 45;
use Test::Exception;
-use Scalar::Util 'reftype', 'isweak';
+use Scalar::Util qw/isweak reftype/;
-BEGIN {
- use_ok('Class::MOP::Instance');
-}
+use Class::MOP::Instance;
can_ok( "Class::MOP::Instance", $_ ) for qw/
- create_instance
- bless_instance_structure
-
- add_slot
- remove_slot
- get_all_slots
- get_all_slots_recursively
- has_slot
- has_slot_recursively
- get_all_parents
-
- get_slot_value
- set_slot_value
- slot_initialized
- initialize_slot
- set_slot_value_with_init
-
- inline_get_slot_value
- inline_set_slot_value
- inline_initialize_slot
- inline_set_slot_value_with_init
+ new
+
+ create_instance
+ bless_instance_structure
+
+ get_all_slots
+
+ initialize_all_slots
+ deinitialize_all_slots
+
+ get_slot_value
+ set_slot_value
+ initialize_slot
+ deinitialize_slot
+ is_slot_initialized
+ weaken_slot_value
+ strengthen_slot_value
+
+ inline_get_slot_value
+ inline_set_slot_value
+ inline_initialize_slot
+ inline_deinitialize_slot
+ inline_is_slot_initialized
+ inline_weaken_slot_value
+ inline_strengthen_slot_value
/;
{
- package Foo;
- use metaclass;
+ package Foo;
+ use metaclass;
- package Bar;
- use metaclass;
- use base qw/Foo/;
-}
+ Foo->meta->add_attribute('moosen');
-isa_ok( my $mi_foo = Foo->meta->get_meta_instance, "Class::MOP::Instance" );
+ package Bar;
+ use metaclass;
+ use base qw/Foo/;
-$mi_foo->add_slot("moosen");
+ Bar->meta->add_attribute('elken');
+}
-is_deeply( [ $mi_foo->get_all_slots ], [ "moosen" ], "get slots" );
+my $mi_foo = Foo->meta->get_meta_instance;
+isa_ok($mi_foo, "Class::MOP::Instance");
+is_deeply(
+ [ $mi_foo->get_all_slots ],
+ [ "moosen" ],
+ '... get all slots for Foo');
my $mi_bar = Bar->meta->get_meta_instance;
+isa_ok($mi_bar, "Class::MOP::Instance");
-is_deeply( [ $mi_bar->get_all_slots ], [], "get slots" );
-is_deeply( [ $mi_bar->get_all_slots_recursively ], ["moosen"], "get slots rec" );
+isnt($mi_foo, $mi_bar, '... they are not the same instance');
-$mi_bar->add_slot("elken");
+is_deeply(
+ [ sort $mi_bar->get_all_slots ],
+ [ "elken", "moosen" ],
+ '... get all slots for Bar');
-is_deeply( [ sort $mi_bar->get_all_slots_recursively ], [qw/elken moosen/], "get slots rec" );
+my $i_foo = $mi_foo->create_instance;
+isa_ok($i_foo, "Foo");
+
+{
+ my $i_foo_2 = $mi_foo->create_instance;
+ isa_ok($i_foo_2, "Foo");
+ isnt($i_foo_2, $i_foo, '... not the same instance');
+ is_deeply($i_foo, $i_foo_2, '... but the same structure');
+}
-isa_ok( my $i_foo = $mi_foo->create_instance, "Foo" );
+ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot not initialized");
-ok( !$mi_foo->get_slot_value( $i_foo, "moosen" ), "no value for slot");
+ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot");
$mi_foo->initialize_slot( $i_foo, "moosen" );
+
+#Removed becayse slot initialization works differently now (groditi)
+#ok($mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot initialized");
+
+ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... but no value for slot");
+
$mi_foo->set_slot_value( $i_foo, "moosen", "the value" );
-is ( $mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "get slot value" );
+is($mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "... get slot value");
+ok(!$i_foo->can('moosen'), '... Foo cant moosen');
+
+my $ref = [];
+
+$mi_foo->set_slot_value( $i_foo, "moosen", $ref );
+$mi_foo->weaken_slot_value( $i_foo, "moosen" );
+
+ok( isweak($i_foo->{moosen}), '... white box test of weaken' );
+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" );
+ok( isweak($i_foo->{moosen}), '... white box test of weaken' );
+$mi_foo->strengthen_slot_value( $i_foo, "moosen" );
+ok( !isweak($i_foo->{moosen}), '... white box test of weaken' );
+
+undef $ref;
+
+is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "weak value can be strengthened" );
-eval 'sub Foo::moosen { ' . $mi_foo->inline_get_slot_value( '$_[0]', '"moosen"' ) . ' }';
-ok( !$@, "compilation of inline get value had no error" );
+$mi_foo->deinitialize_slot( $i_foo, "moosen" );
-is( $i_foo->moosen, "the value", "inline get value" );
+ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot deinitialized");
-$mi_foo->set_slot_value( $i_foo, "moosen", "the other value" );
+ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot");
-is( $i_foo->moosen, "the other value", "inline get value");