t/010_basics/005_override_augment_inner_super.t

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