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