diff options
Diffstat (limited to 't/basics/inner_and_augment.t')
-rw-r--r-- | t/basics/inner_and_augment.t | 117 |
1 files changed, 117 insertions, 0 deletions
diff --git a/t/basics/inner_and_augment.t b/t/basics/inner_and_augment.t new file mode 100644 index 0000000..c343c38 --- /dev/null +++ b/t/basics/inner_and_augment.t @@ -0,0 +1,117 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + + +{ + package Foo; + use Moose; + + sub foo { 'Foo::foo(' . (inner() || '') . ')' } + sub bar { 'Foo::bar(' . (inner() || '') . ')' } + sub baz { 'Foo::baz(' . (inner() || '') . ')' } + + package Bar; + use Moose; + + extends 'Foo'; + + augment foo => sub { 'Bar::foo(' . (inner() || '') . ')' }; + augment bar => sub { 'Bar::bar' }; + + no Moose; # ensure inner() still works after unimport + + package Baz; + use Moose; + + extends 'Bar'; + + augment foo => sub { 'Baz::foo' }; + augment baz => sub { 'Baz::baz' }; + + # this will actually never run, + # because Bar::bar does not call inner() + augment bar => sub { 'Baz::bar' }; +} + +my $baz = Baz->new(); +isa_ok($baz, 'Baz'); +isa_ok($baz, 'Bar'); +isa_ok($baz, 'Foo'); + +is($baz->foo(), 'Foo::foo(Bar::foo(Baz::foo))', '... got the right value from &foo'); +is($baz->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar'); +is($baz->baz(), 'Foo::baz(Baz::baz)', '... got the right value from &baz'); + +my $bar = Bar->new(); +isa_ok($bar, 'Bar'); +isa_ok($bar, 'Foo'); + +is($bar->foo(), 'Foo::foo(Bar::foo())', '... got the right value from &foo'); +is($bar->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar'); +is($bar->baz(), 'Foo::baz()', '... got the right value from &baz'); + +my $foo = Foo->new(); +isa_ok($foo, 'Foo'); + +is($foo->foo(), 'Foo::foo()', '... got the right value from &foo'); +is($foo->bar(), 'Foo::bar()', '... got the right value from &bar'); +is($foo->baz(), 'Foo::baz()', '... got the right value from &baz'); + +# test saved state when crossing objects + +{ + package X; + use Moose; + has name => (is => 'rw'); + sub run { + "$_[0]->{name}.X", inner() + } + + package Y; + use Moose; + extends 'X'; + augment 'run' => sub { + "$_[0]->{name}.Y", ($_[1] ? $_[1]->() : ()), inner(); + }; + + package Z; + use Moose; + extends 'Y'; + augment 'run' => sub { + "$_[0]->{name}.Z" + } +} + +is('a.X a.Y b.X b.Y b.Z a.Z', + do { + my $a = Z->new(name => 'a'); + my $b = Z->new(name => 'b'); + join(' ', $a->run(sub { $b->run })) + }, + 'State is saved when cross-calling augmented methods on different objects'); + +# some error cases + +{ + package Bling; + use Moose; + + sub bling { 'Bling::bling' } + + package Bling::Bling; + use Moose; + + extends 'Bling'; + + sub bling { 'Bling::bling' } + + ::isnt( ::exception { + augment 'bling' => sub {}; + }, undef, '... cannot augment a method which has a local equivalent' ); + +} + +done_testing; |