[gitmo/Moose.git] / t / 100_bugs / 009_augment_recursion_bug.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 4;

BEGIN {
    use_ok('Moose');
}

{
    package Foo;
    use Moose;

    sub foo { 'Foo::foo(' . (inner() || '') . ')' };

    package Bar;
    use Moose;

    extends 'Foo';

    package Baz;
    use Moose;

    extends 'Foo';

    my $foo_call_counter;
    augment 'foo' => sub {
        die "infinite loop on Baz::foo" if $foo_call_counter++ > 1;
        return 'Baz::foo and ' . Bar->new->foo;
    };
}

my $baz = Baz->new();
isa_ok($baz, 'Baz');
isa_ok($baz, 'Foo');

=pod

When a subclass which augments foo(), calls a subclass which does not augment
foo(), there is a chance for some confusion. If Moose does not realize that
Bar does not augment foo(), becuase it is in the call flow of Baz which does,
then we may have an infinite loop.

=cut

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