t/105_ClassEncapsulatedAttributes_test.t

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