t/060_instance.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More 'no_plan';
   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         get_slot_value
  24         set_slot_value
  25         initialize_slot
  26         initialize_all_slots
  27         is_slot_initialized
  28 /;
  29
  30 {
  31         package Foo;
  32         use metaclass;
  33
  34         Foo->meta->add_attribute('moosen');
  35
  36         package Bar;
  37         use metaclass;
  38         use base qw/Foo/;
  39
  40         Bar->meta->add_attribute('elken');
  41 }
  42
  43 my $mi_foo = Foo->meta->get_meta_instance;
  44 isa_ok($mi_foo, "Class::MOP::Instance");
  45
  46 is_deeply(
  47     [ $mi_foo->get_all_slots ],
  48     [ "moosen" ],
  49     '... get all slots for Foo');
  50
  51 my $mi_bar = Bar->meta->get_meta_instance;
  52 isa_ok($mi_bar, "Class::MOP::Instance");
  53
  54 isnt($mi_foo, $mi_bar, '... they are not the same instance');
  55
  56 is_deeply(
  57     [ sort $mi_bar->get_all_slots ],
  58     [ "elken", "moosen" ],
  59     '... get all slots for Bar');
  60
  61 my $i_foo = $mi_foo->create_instance;
  62 isa_ok($i_foo, "Foo");
  63
  64 {
  65     my $i_foo_2 = $mi_foo->create_instance;
  66     isa_ok($i_foo_2, "Foo");
  67     isnt($i_foo_2, $i_foo, '... not the same instance');
  68     is_deeply($i_foo, $i_foo_2, '... but the same structure');
  69 }
  70
  71 ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot");
  72
  73 $mi_foo->set_slot_value( $i_foo, "moosen", "the value" );
  74
  75 is($mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "... get slot value");
  76
  77 ok(!$i_foo->can('moosen'), '... Foo cant moosen');
  78
  79 can_ok( $mi_foo, "set_slot_value_weak" );
  80
  81 my $ref = [];
  82 $mi_foo->set_slot_value_weak( $i_foo, "moosen", $ref );
  83
  84 is( $mi_foo->get_slot_value( $i_foo, "moosen" ), $ref, "weak value is fetchable" );
  85
  86 ok( !isweak($mi_foo->get_slot_value( $i_foo, "moosen" )), "return value not weak" );
  87
  88 undef $ref;
  89
  90 is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" );
  91
  92 $ref = [];
  93
  94 $mi_foo->set_slot_value( $i_foo, "moosen", $ref );
  95
  96 undef $ref;
  97
  98 is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "value not weak yet" );
  99
 100 $mi_foo->weaken_slot_value( $i_foo, "moosen" );
 101
 102 is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" );
 103
 104
 105 $ref = [];
 106
 107 $mi_foo->set_slot_value( $i_foo, "moosen", $ref );
 108
 109
 110 $mi_foo->weaken_slot_value( $i_foo, "moosen" );
 111
 112 $mi_foo->strengthen_slot_value( $i_foo, "moosen" );
 113
 114 undef $ref;
 115
 116 is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "weak value can be strengthened" );
 117
 118