X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=t%2F020_attributes%2F032_delegation_arg_aliasing.t;fp=t%2F020_attributes%2F032_delegation_arg_aliasing.t;h=084c2ba95256c0c6ee4c499075846d37268e0c3d;hp=0000000000000000000000000000000000000000;hb=1f5ce14ae261aa33d3920121f86a1b6a5a5b1b43;hpb=1eb43e0a41287a5b7de774527e379f9ed57e7e21 diff --git a/t/020_attributes/032_delegation_arg_aliasing.t b/t/020_attributes/032_delegation_arg_aliasing.t new file mode 100644 index 0000000..084c2ba --- /dev/null +++ b/t/020_attributes/032_delegation_arg_aliasing.t @@ -0,0 +1,44 @@ +#!/usr/bin/env perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; +use strict; +use warnings; +use Test::More; + +{ + package Foo; + use Mouse; + + sub aliased { + my $self = shift; + $_[1] = $_[0]; + } +} + +{ + package HasFoo; + use Mouse; + + has foo => ( + is => 'ro', + isa => 'Foo', + handles => { + foo_aliased => 'aliased', + foo_aliased_curried => ['aliased', 'bar'], + } + ); +} + +my $hasfoo = HasFoo->new(foo => Foo->new); +my $x; +$hasfoo->foo->aliased('foo', $x); +is($x, 'foo', "direct aliasing works"); +undef $x; +$hasfoo->foo_aliased('foo', $x); +is($x, 'foo', "delegated aliasing works"); +undef $x; +$hasfoo->foo_aliased_curried($x); +is($x, 'bar', "delegated aliasing with currying works"); + +done_testing;