t/013_inner_and_augment.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 17;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 {
  14     package Foo;
  15     use strict;
  16     use warnings;
  17     use Moose;
  18
  19     sub foo { 'Foo::foo(' . (inner() || '') . ')' }
  20     sub bar { 'Foo::bar(' . (inner() || '') . ')' }
  21     sub baz { 'Foo::baz(' . (inner() || '') . ')' }
  22
  23     package Bar;
  24     use strict;
  25     use warnings;
  26     use Moose;
  27
  28     extends 'Foo';
  29
  30     augment foo => sub { 'Bar::foo(' . (inner() || '') . ')' };
  31     augment bar => sub { 'Bar::bar' };
  32
  33     package Baz;
  34     use strict;
  35     use warnings;
  36     use Moose;
  37
  38     extends 'Bar';
  39
  40     augment foo => sub { 'Baz::foo' };
  41     augment baz => sub { 'Baz::baz' };
  42
  43     # this will actually never run,
  44     # because Bar::bar does not call inner()
  45     augment bar => sub { 'Baz::bar' };
  46 }
  47
  48 my $baz = Baz->new();
  49 isa_ok($baz, 'Baz');
  50 isa_ok($baz, 'Bar');
  51 isa_ok($baz, 'Foo');
  52
  53 is($baz->foo(), 'Foo::foo(Bar::foo(Baz::foo))', '... got the right value from &foo');
  54 is($baz->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar');
  55 is($baz->baz(), 'Foo::baz(Baz::baz)', '... got the right value from &baz');
  56
  57 my $bar = Bar->new();
  58 isa_ok($bar, 'Bar');
  59 isa_ok($bar, 'Foo');
  60
  61 is($bar->foo(), 'Foo::foo(Bar::foo())', '... got the right value from &foo');
  62 is($bar->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar');
  63 is($bar->baz(), 'Foo::baz()', '... got the right value from &baz');
  64
  65 my $foo = Foo->new();
  66 isa_ok($foo, 'Foo');
  67
  68 is($foo->foo(), 'Foo::foo()', '... got the right value from &foo');
  69 is($foo->bar(), 'Foo::bar()', '... got the right value from &bar');
  70 is($foo->baz(), 'Foo::baz()', '... got the right value from &baz');
  71
  72 # some error cases
  73
  74 {
  75     package Bling;
  76     use strict;
  77     use warnings;
  78     use Moose;
  79
  80     sub bling { 'Bling::bling' }
  81
  82     package Bling::Bling;
  83     use strict;
  84     use warnings;
  85     use Moose;
  86
  87     extends 'Bling';
  88
  89     sub bling { 'Bling::bling' }
  90
  91     ::dies_ok {
  92         augment 'bling' => sub {};
  93     } '... cannot augment a method which has a local equivalent';
  94
  95 }
  96