t/060_instance.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 22;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP::Instance');
  11 }
  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         get_slot_value
  22         set_slot_value
  23         initialize_slot
  24         initialize_all_slots
  25         is_slot_initialized
  26 /;
  27
  28 {
  29         package Foo;
  30         use metaclass;
  31
  32         Foo->meta->add_attribute('moosen');
  33
  34         package Bar;
  35         use metaclass;
  36         use base qw/Foo/;
  37
  38         Bar->meta->add_attribute('elken');
  39 }
  40
  41 my $mi_foo = Foo->meta->get_meta_instance;
  42 isa_ok($mi_foo, "Class::MOP::Instance");
  43
  44 is_deeply(
  45     [ $mi_foo->get_all_slots ],
  46     [ "moosen" ],
  47     '... get all slots for Foo');
  48
  49 my $mi_bar = Bar->meta->get_meta_instance;
  50 isa_ok($mi_bar, "Class::MOP::Instance");
  51
  52 isnt($mi_foo, $mi_bar, '... they are not the same instance');
  53
  54 is_deeply(
  55     [ sort $mi_bar->get_all_slots ],
  56     [ "elken", "moosen" ],
  57     '... get all slots for Bar');
  58
  59 my $i_foo = $mi_foo->create_instance;
  60 isa_ok($i_foo, "Foo");
  61
  62 {
  63     my $i_foo_2 = $mi_foo->create_instance;
  64     isa_ok($i_foo_2, "Foo");
  65     isnt($i_foo_2, $i_foo, '... not the same instance');
  66     is_deeply($i_foo, $i_foo_2, '... but the same structure');
  67 }
  68
  69 ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot");
  70
  71 $mi_foo->set_slot_value( $i_foo, "moosen", "the value" );
  72
  73 is($mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "... get slot value");
  74
  75 ok(!$i_foo->can('moosen'), '... Foo cant moosen');