t/basics/override_augment_inner_super.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8
   9 {
  10     package Foo;
  11     use Moose;
  12
  13     sub foo { 'Foo::foo(' . (inner() || '') . ')' };
  14     sub bar { 'Foo::bar(' . (inner() || '') . ')' }
  15
  16     package Bar;
  17     use Moose;
  18
  19     extends 'Foo';
  20
  21     augment  'foo' => sub { 'Bar::foo' };
  22     override 'bar' => sub { 'Bar::bar -> ' . super() };
  23
  24     package Baz;
  25     use Moose;
  26
  27     extends 'Bar';
  28
  29     override 'foo' => sub { 'Baz::foo -> ' . super() };
  30     augment  'bar' => sub { 'Baz::bar' };
  31 }
  32
  33 my $baz = Baz->new();
  34 isa_ok($baz, 'Baz');
  35 isa_ok($baz, 'Bar');
  36 isa_ok($baz, 'Foo');
  37
  38 =pod
  39
  40 Let em clarify what is happening here. Baz::foo is calling
  41 super(), which calls Bar::foo, which is an augmented sub
  42 that calls Foo::foo, then calls inner() which actually
  43 then calls Bar::foo. Confusing I know,.. but this is
  44 *exactly* what is it supposed to do :)
  45
  46 =cut
  47
  48 is($baz->foo,
  49   'Baz::foo -> Foo::foo(Bar::foo)',
  50   '... got the right value from mixed augment/override foo');
  51
  52 =pod
  53
  54 Allow me to clarify this one now ...
  55
  56 Since Baz::bar is an augment routine, it needs to find the
  57 correct inner() to be called by. In this case it is Foo::bar.
  58 However, Bar::bar is in-between us, so it should actually be
  59 called first. Bar::bar is an overriden sub, and calls super()
  60 which in turn then calls our Foo::bar, which calls inner(),
  61 which calls Baz::bar.
  62
  63 Confusing I know, but it is correct :)
  64
  65 =cut
  66
  67 is($baz->bar,
  68     'Bar::bar -> Foo::bar(Baz::bar)',
  69     '... got the right value from mixed augment/override bar');
  70
  71 done_testing;