t/100_bugs/009_augment_recursion_bug.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3;
   7
   8
   9
  10 {
  11     package Foo;
  12     use Mouse;
  13
  14     sub foo { 'Foo::foo(' . (inner() || '') . ')' };
  15
  16     package Bar;
  17     use Mouse;
  18
  19     extends 'Foo';
  20
  21     package Baz;
  22     use Mouse;
  23
  24     extends 'Foo';
  25
  26     my $foo_call_counter;
  27     augment 'foo' => sub {
  28         die "infinite loop on Baz::foo" if $foo_call_counter++ > 1;
  29         return 'Baz::foo and ' . Bar->new->foo;
  30     };
  31 }
  32
  33 my $baz = Baz->new();
  34 isa_ok($baz, 'Baz');
  35 isa_ok($baz, 'Foo');
  36
  37 =pod
  38
  39 When a subclass which augments foo(), calls a subclass which does not augment
  40 foo(), there is a chance for some confusion. If Mouse does not realize that
  41 Bar does not augment foo(), because it is in the call flow of Baz which does,
  42 then we may have an infinite loop.
  43
  44 =cut
  45
  46 is($baz->foo,
  47   'Foo::foo(Baz::foo and Foo::foo())',
  48   '... got the right value for 1 augmented subclass calling non-augmented subclass');
  49