t/105_ClassEncapsulatedAttributes_test.t

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