t/105_ClassEncapsulatedAttributes_test.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 28;
   5 use File::Spec;
   6
   7 BEGIN {use Class::MOP;
   8     require_ok(File::Spec->catfile('examples', 'ClassEncapsulatedAttributes.pod'));
   9 }
  10
  11 {
  12     package Foo;
  13
  14     use metaclass 'ClassEncapsulatedAttributes';
  15
  16     Foo->meta->add_attribute('foo' => (
  17         accessor  => 'foo',
  18         predicate => 'has_foo',
  19         default   => 'init in FOO'
  20     ));
  21
  22     Foo->meta->add_attribute('bar' => (
  23         reader  => 'get_bar',
  24         writer  => 'set_bar',
  25         default => 'init in FOO'
  26     ));
  27
  28     sub new  {
  29         my $class = shift;
  30         $class->meta->new_object(@_);
  31     }
  32
  33     package Bar;
  34     our @ISA = ('Foo');
  35
  36     Bar->meta->add_attribute('foo' => (
  37         accessor  => 'foo',
  38         predicate => 'has_foo',
  39         default   => 'init in BAR'
  40     ));
  41
  42     Bar->meta->add_attribute('bar' => (
  43         reader  => 'get_bar',
  44         writer  => 'set_bar',
  45         default => 'init in BAR'
  46     ));
  47
  48     sub SUPER_foo     { (shift)->SUPER::foo(@_)     }
  49     sub SUPER_has_foo { (shift)->SUPER::foo(@_)     }
  50     sub SUPER_get_bar { (shift)->SUPER::get_bar()   }
  51     sub SUPER_set_bar { (shift)->SUPER::set_bar(@_) }
  52
  53 }
  54
  55 {
  56     my $foo = Foo->new();
  57     isa_ok($foo, 'Foo');
  58
  59     can_ok($foo, 'foo');
  60     can_ok($foo, 'has_foo');
  61     can_ok($foo, 'get_bar');
  62     can_ok($foo, 'set_bar');
  63
  64     my $bar = Bar->new();
  65     isa_ok($bar, 'Bar');
  66
  67     can_ok($bar, 'foo');
  68     can_ok($bar, 'has_foo');
  69     can_ok($bar, 'get_bar');
  70     can_ok($bar, 'set_bar');
  71
  72     ok($foo->has_foo, '... Foo::has_foo == 1');
  73     ok($bar->has_foo, '... Bar::has_foo == 1');
  74
  75     is($foo->foo, 'init in FOO', '... got the right default value for Foo::foo');
  76     is($bar->foo, 'init in BAR', '... got the right default value for Bar::foo');
  77
  78     is($bar->SUPER_foo(), 'init in FOO', '... got the right default value for Bar::SUPER::foo');
  79
  80     $bar->SUPER_foo(undef);
  81
  82     is($bar->SUPER_foo(), undef, '... successfully set Foo::foo through Bar::SUPER::foo');
  83     ok(!$bar->SUPER_has_foo, '... BAR::SUPER::has_foo == 0');
  84
  85     ok($foo->has_foo, '... Foo::has_foo (is still) 1');
  86 }
  87
  88 {
  89     my $bar = Bar->new(
  90         'Foo' => { 'foo' => 'Foo::foo' },
  91         'Bar' => { 'foo' => 'Bar::foo' }
  92     );
  93     isa_ok($bar, 'Bar');
  94
  95     can_ok($bar, 'foo');
  96     can_ok($bar, 'has_foo');
  97     can_ok($bar, 'get_bar');
  98     can_ok($bar, 'set_bar');
  99
 100     ok($bar->has_foo, '... Bar::has_foo == 1');
 101     ok($bar->SUPER_has_foo, '... Bar::SUPER_has_foo == 1');
 102
 103     is($bar->foo, 'Bar::foo', '... got the right default value for Bar::foo');
 104     is($bar->SUPER_foo(), 'Foo::foo', '... got the right default value for Bar::SUPER::foo');
 105 }
 106