t/014_override_augment_inner_super.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 6;
   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
  21     package Bar;
  22     use strict;
  23     use warnings;
  24     use Moose;
  25
  26     extends 'Foo';
  27
  28     augment  'foo' => sub { 'Bar::foo' };
  29     override 'bar' => sub { 'Bar::bar -> ' . super() };
  30
  31     package Baz;
  32     use strict;
  33     use warnings;
  34     use Moose;
  35
  36     extends 'Bar';
  37
  38     override 'foo' => sub { 'Baz::foo -> ' . super() };
  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 =pod
  48
  49 Let em clarify what is happening here. Baz::foo is calling
  50 super(), which calls Bar::foo, which is an augmented sub
  51 that calls Foo::foo, then calls inner() which actually
  52 then calls Bar::foo. Confusing I know,.. but this is
  53 *exactly* what is it supposed to do :)
  54
  55 =cut
  56
  57 is($baz->foo,
  58   'Baz::foo -> Foo::foo(Bar::foo)',
  59   '... got the right value from mixed augment/override foo');
  60
  61 =pod
  62
  63 Allow me to clarify this one now ...
  64
  65 Since Baz::bar is an augment routine, it needs to find the
  66 correct inner() to be called by. In this case it is Foo::bar.
  67 However, Bar::bar is inbetween us, so it should actually be
  68 called first. Bar::bar is an overriden sub, and calls super()
  69 which in turn then calls our Foo::bar, which calls inner(),
  70 which calls Baz::bar.
  71
  72 Confusing I know, but it is correct :)
  73
  74 =cut
  75
  76 is($baz->bar,
  77     'Bar::bar -> Foo::bar(Baz::bar)',
  78     '... got the right value from mixed augment/override bar');