t/060_instance.t

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