X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F060_instance.t;h=b8937442657e814537542ae1b2313e37e9b3b2fb;hb=164bf00ba31a0c8e486033690a54fea2112fe207;hp=36657f1eddf22243e887f284d891c8198d839e3a;hpb=49c93440bd912ed231b8ab8e93a8e9ac7328fdc7;p=gitmo%2FClass-MOP.git diff --git a/t/060_instance.t b/t/060_instance.t index 36657f1..b893744 100644 --- a/t/060_instance.t +++ b/t/060_instance.t @@ -1,49 +1,60 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 25; +use Test::More tests => 45; use Test::Exception; -BEGIN { - use_ok('Class::MOP::Instance'); -} +use Scalar::Util qw/isweak reftype/; + +use Class::MOP::Instance; can_ok( "Class::MOP::Instance", $_ ) for qw/ - new - - create_instance - bless_instance_structure + new - get_all_slots + create_instance + bless_instance_structure - get_slot_value - set_slot_value + get_all_slots - inline_get_slot_value - inline_set_slot_value + 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; - - Foo->meta->add_attribute('moosen'); + package Foo; + use metaclass; + + Foo->meta->add_attribute('moosen'); - package Bar; - use metaclass; - use base qw/Foo/; + package Bar; + use metaclass; + use base qw/Foo/; - Bar->meta->add_attribute('elken'); + Bar->meta->add_attribute('elken'); } my $mi_foo = Foo->meta->get_meta_instance; isa_ok($mi_foo, "Class::MOP::Instance"); is_deeply( - [ $mi_foo->get_all_slots ], - [ "moosen" ], + [ $mi_foo->get_all_slots ], + [ "moosen" ], '... get all slots for Foo'); my $mi_bar = Bar->meta->get_meta_instance; @@ -52,8 +63,8 @@ isa_ok($mi_bar, "Class::MOP::Instance"); isnt($mi_foo, $mi_bar, '... they are not the same instance'); is_deeply( - [ sort $mi_bar->get_all_slots ], - [ "elken", "moosen" ], + [ sort $mi_bar->get_all_slots ], + [ "elken", "moosen" ], '... get all slots for Bar'); my $i_foo = $mi_foo->create_instance; @@ -61,26 +72,67 @@ isa_ok($i_foo, "Foo"); { my $i_foo_2 = $mi_foo->create_instance; - isa_ok($i_foo_2, "Foo"); + 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'); } +ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot not initialized"); + 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"); - ok(!$i_foo->can('moosen'), '... Foo cant moosen'); -eval 'sub Foo::moosen { ' . $mi_foo->inline_get_slot_value( '$_[0]', 'moosen' ) . ' }'; -ok(!$@, "compilation of inline get value had no error"); +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" ); -can_ok($i_foo, 'moosen'); +undef $ref; -is($i_foo->moosen, "the value", "... inline get value worked"); +is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" ); -$mi_foo->set_slot_value( $i_foo, "moosen", "the other value" ); +$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" ); + +$mi_foo->deinitialize_slot( $i_foo, "moosen" ); + +ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot deinitialized"); + +ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot"); -is($i_foo->moosen, "the other value", "... inline get value worked (even after value is changed)");