t/060_instance.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   6
   7 use Scalar::Util qw/isweak reftype/;
   8
   9 use Class::MOP::Instance;
  10
  11 can_ok( "Class::MOP::Instance", $_ ) for qw/
  12         new
  13
  14         create_instance
  15         bless_instance_structure
  16
  17         get_all_slots
  18
  19         initialize_all_slots
  20         deinitialize_all_slots
  21
  22         get_slot_value
  23         set_slot_value
  24         initialize_slot
  25         deinitialize_slot
  26         is_slot_initialized
  27         weaken_slot_value
  28         strengthen_slot_value
  29
  30         inline_get_slot_value
  31         inline_set_slot_value
  32         inline_initialize_slot
  33         inline_deinitialize_slot
  34         inline_is_slot_initialized
  35         inline_weaken_slot_value
  36         inline_strengthen_slot_value
  37 /;
  38
  39 {
  40         package Foo;
  41         use metaclass;
  42
  43         Foo->meta->add_attribute('moosen');
  44
  45         package Bar;
  46         use metaclass;
  47         use base qw/Foo/;
  48
  49         Bar->meta->add_attribute('elken');
  50 }
  51
  52 my $mi_foo = Foo->meta->get_meta_instance;
  53 isa_ok($mi_foo, "Class::MOP::Instance");
  54
  55 is_deeply(
  56     [ $mi_foo->get_all_slots ],
  57     [ "moosen" ],
  58     '... get all slots for Foo');
  59
  60 my $mi_bar = Bar->meta->get_meta_instance;
  61 isa_ok($mi_bar, "Class::MOP::Instance");
  62
  63 isnt($mi_foo, $mi_bar, '... they are not the same instance');
  64
  65 is_deeply(
  66     [ sort $mi_bar->get_all_slots ],
  67     [ "elken", "moosen" ],
  68     '... get all slots for Bar');
  69
  70 my $i_foo = $mi_foo->create_instance;
  71 isa_ok($i_foo, "Foo");
  72
  73 {
  74     my $i_foo_2 = $mi_foo->create_instance;
  75     isa_ok($i_foo_2, "Foo");
  76     isnt($i_foo_2, $i_foo, '... not the same instance');
  77     is_deeply($i_foo, $i_foo_2, '... but the same structure');
  78 }
  79
  80 ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot not initialized");
  81
  82 ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot");
  83
  84 $mi_foo->initialize_slot( $i_foo, "moosen" );
  85
  86 #Removed becayse slot initialization works differently now (groditi)
  87 #ok($mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot initialized");
  88
  89 ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... but no value for slot");
  90
  91 $mi_foo->set_slot_value( $i_foo, "moosen", "the value" );
  92
  93 is($mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "... get slot value");
  94 ok(!$i_foo->can('moosen'), '... Foo cant moosen');
  95
  96 my $ref = [];
  97
  98 $mi_foo->set_slot_value( $i_foo, "moosen", $ref );
  99 $mi_foo->weaken_slot_value( $i_foo, "moosen" );
 100
 101 ok( isweak($i_foo->{moosen}), '... white box test of weaken' );
 102 is( $mi_foo->get_slot_value( $i_foo, "moosen" ), $ref, "weak value is fetchable" );
 103 ok( !isweak($mi_foo->get_slot_value( $i_foo, "moosen" )), "return value not weak" );
 104
 105 undef $ref;
 106
 107 is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" );
 108
 109 $ref = [];
 110
 111 $mi_foo->set_slot_value( $i_foo, "moosen", $ref );
 112
 113 undef $ref;
 114
 115 is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "value not weak yet" );
 116
 117 $mi_foo->weaken_slot_value( $i_foo, "moosen" );
 118
 119 is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" );
 120
 121 $ref = [];
 122
 123 $mi_foo->set_slot_value( $i_foo, "moosen", $ref );
 124 $mi_foo->weaken_slot_value( $i_foo, "moosen" );
 125 ok( isweak($i_foo->{moosen}), '... white box test of weaken' );
 126 $mi_foo->strengthen_slot_value( $i_foo, "moosen" );
 127 ok( !isweak($i_foo->{moosen}), '... white box test of weaken' );
 128
 129 undef $ref;
 130
 131 is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "weak value can be strengthened" );
 132
 133 $mi_foo->deinitialize_slot( $i_foo, "moosen" );
 134
 135 ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot deinitialized");
 136
 137 ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot");
 138
 139 done_testing;