t/060_instance.t

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