summaryrefslogtreecommitdiff
path: root/t/basics/inner_and_augment.t
diff options
context:
space:
mode:
Diffstat (limited to 't/basics/inner_and_augment.t')
-rw-r--r--t/basics/inner_and_augment.t117
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;