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