t/013_inner_and_augment.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 16;
   7
   8 BEGIN {
   9     use_ok('Moose');
  10 }
  11
  12 {
  13     package Foo;
  14     use strict;
  15     use warnings;
  16     use Moose;
  17
  18     sub foo { 'Foo::foo(' . (inner() || '') . ')' }
  19     sub bar { 'Foo::bar(' . (inner() || '') . ')' }
  20     sub baz { 'Foo::baz(' . (inner() || '') . ')' }
  21
  22     package Bar;
  23     use strict;
  24     use warnings;
  25     use Moose;
  26
  27     extends 'Foo';
  28
  29     augment foo => sub { 'Bar::foo(' . (inner() || '') . ')' };
  30     augment bar => sub { 'Bar::bar' };
  31
  32     package Baz;
  33     use strict;
  34     use warnings;
  35     use Moose;
  36
  37     extends 'Bar';
  38
  39     augment foo => sub { 'Baz::foo' };
  40     augment baz => sub { 'Baz::baz' };
  41
  42     # this will actually never run,
  43     # because Bar::bar does not call inner()
  44     augment bar => sub { 'Baz::bar' };
  45 }
  46
  47 my $baz = Baz->new();
  48 isa_ok($baz, 'Baz');
  49 isa_ok($baz, 'Bar');
  50 isa_ok($baz, 'Foo');
  51
  52 is($baz->foo(), 'Foo::foo(Bar::foo(Baz::foo))', '... got the right value from &foo');
  53 is($baz->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar');
  54 is($baz->baz(), 'Foo::baz(Baz::baz)', '... got the right value from &baz');
  55
  56 my $bar = Bar->new();
  57 isa_ok($bar, 'Bar');
  58 isa_ok($bar, 'Foo');
  59
  60 is($bar->foo(), 'Foo::foo(Bar::foo())', '... got the right value from &foo');
  61 is($bar->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar');
  62 is($bar->baz(), 'Foo::baz()', '... got the right value from &baz');
  63
  64 my $foo = Foo->new();
  65 isa_ok($foo, 'Foo');
  66
  67 is($foo->foo(), 'Foo::foo()', '... got the right value from &foo');
  68 is($foo->bar(), 'Foo::bar()', '... got the right value from &bar');
  69 is($foo->baz(), 'Foo::baz()', '... got the right value from &baz');