t/bugs/augment_recursion_bug.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
  15     package Bar;
  16     use Moose;
  17
  18     extends 'Foo';
  19
  20     package Baz;
  21     use Moose;
  22
  23     extends 'Foo';
  24
  25     my $foo_call_counter;
  26     augment 'foo' => sub {
  27         die "infinite loop on Baz::foo" if $foo_call_counter++ > 1;
  28         return 'Baz::foo and ' . Bar->new->foo;
  29     };
  30 }
  31
  32 my $baz = Baz->new();
  33 isa_ok($baz, 'Baz');
  34 isa_ok($baz, 'Foo');
  35
  36 =pod
  37
  38 When a subclass which augments foo(), calls a subclass which does not augment
  39 foo(), there is a chance for some confusion. If Moose does not realize that
  40 Bar does not augment foo(), because it is in the call flow of Baz which does,
  41 then we may have an infinite loop.
  42
  43 =cut
  44
  45 is($baz->foo,
  46   'Foo::foo(Baz::foo and Foo::foo())',
  47   '... got the right value for 1 augmented subclass calling non-augmented subclass');
  48
  49 done_testing;