t/010_basics/004_inner_and_augment.t

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