t/060_instance.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 30;
   7 use Test::Exception;
   8
   9 use Scalar::Util 'reftype', 'isweak';
  10
  11 BEGIN {
  12     use_ok('Class::MOP::Instance');
  13 }
  14
  15 can_ok( "Class::MOP::Instance", $_ ) for qw/
  16         create_instance
  17         bless_instance_structure
  18
  19         add_slot
  20         remove_slot
  21         get_all_slots
  22         get_all_slots_recursively
  23         has_slot
  24         has_slot_recursively
  25         get_all_parents
  26
  27         get_slot_value
  28         set_slot_value
  29         slot_initialized
  30         initialize_slot
  31         set_slot_value_with_init
  32
  33         inline_get_slot_value
  34         inline_set_slot_value
  35         inline_initialize_slot
  36         inline_set_slot_value_with_init
  37 /;
  38
  39 {
  40         package Foo;
  41         use metaclass;
  42
  43         package Bar;
  44         use metaclass;
  45         use base qw/Foo/;
  46 }
  47
  48 isa_ok( my $mi_foo = Foo->meta->get_meta_instance, "Class::MOP::Instance" );
  49
  50 $mi_foo->add_slot("moosen");
  51
  52 is_deeply( [ $mi_foo->get_all_slots ], [ "moosen" ], "get slots" );
  53
  54
  55 my $mi_bar = Bar->meta->get_meta_instance;
  56
  57 is_deeply( [ $mi_bar->get_all_slots ], [], "get slots" );
  58 is_deeply( [ $mi_bar->get_all_slots_recursively ], ["moosen"], "get slots rec" );
  59
  60 $mi_bar->add_slot("elken");
  61
  62 is_deeply( [ sort $mi_bar->get_all_slots_recursively ], [qw/elken moosen/], "get slots rec" );
  63
  64 isa_ok( my $i_foo = $mi_foo->create_instance, "Foo" );
  65
  66 ok( !$mi_foo->get_slot_value( $i_foo, "moosen" ), "no value for slot");
  67
  68 $mi_foo->initialize_slot( $i_foo, "moosen" );
  69 $mi_foo->set_slot_value( $i_foo, "moosen", "the value" );
  70
  71 is ( $mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "get slot value" );
  72
  73 eval 'sub Foo::moosen { ' . $mi_foo->inline_get_slot_value( '$_[0]', '"moosen"' ) . ' }';
  74 ok( !$@, "compilation of inline get value had no error" );
  75
  76 is( $i_foo->moosen, "the value", "inline get value" );
  77
  78 $mi_foo->set_slot_value( $i_foo, "moosen", "the other value" );
  79
  80 is( $i_foo->moosen, "the other value", "inline get value");