diff options
author | Jesse Luehrs <doy@tozt.net> | 2009-05-27 23:06:40 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2009-05-27 23:06:40 -0500 |
commit | a8f3de3d9e8c11aa5f21a5f0c4c7f5dc748109e2 (patch) | |
tree | fabb67d4890903acf9a65f2eece891b28f61ffbc | |
parent | 2b735d5acb55cd8925a10566263a11dd8f32604e (diff) | |
download | moosex-mangle-a8f3de3d9e8c11aa5f21a5f0c4c7f5dc748109e2.tar.gz moosex-mangle-a8f3de3d9e8c11aa5f21a5f0c4c7f5dc748109e2.zip |
tests for mangle_args and mangle_return
-rw-r--r-- | t/010-mangle-args.t | 41 | ||||
-rw-r--r-- | t/011-mangle-return.t | 44 |
2 files changed, 85 insertions, 0 deletions
diff --git a/t/010-mangle-args.t b/t/010-mangle-args.t new file mode 100644 index 0000000..1f07ca7 --- /dev/null +++ b/t/010-mangle-args.t @@ -0,0 +1,41 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 4; + +package Foo; +use Moose; + +sub foo { + shift; + return reverse @_; +} + +sub bar { + shift; + return join '-', @_ +} + +package Foo::Sub; +use Moose; +use MooseX::Mangle; +extends 'Foo'; + +mangle_args foo => sub { + shift; + return map { uc } @_; +}; + +mangle_args bar => sub { + my $self = shift; + pop; + return @_; +}; + +package main; +my $foo = Foo->new; +my $foosub = Foo::Sub->new; +is_deeply([$foo->foo(qw(a b c))], [qw(c b a)], 'unmodified method foo'); +is($foo->bar(qw(a b c)), 'a-b-c', 'unmodified method bar'); +is_deeply([$foosub->foo(qw(a b c))], [qw(C B A)], "foo's args are mangled"); +is($foosub->bar(qw(a b c)), 'a-b', "bar's args are mangled"); diff --git a/t/011-mangle-return.t b/t/011-mangle-return.t new file mode 100644 index 0000000..0db182b --- /dev/null +++ b/t/011-mangle-return.t @@ -0,0 +1,44 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 5; + +package Foo; +use Moose; + +sub foo { + shift; + my @ret = reverse @_; + return @ret; +} + +sub bar { + shift; + return join '-', @_ +} + +package Foo::Sub; +use Moose; +use MooseX::Mangle; +extends 'Foo'; + +mangle_return foo => sub { + my $self = shift; + return wantarray ? (@_, 'd') : shift() - 1; +}; + +mangle_return bar => sub { + my $self = shift; + my ($ret) = @_; + $ret =~ s/-/:/g; + return $ret; +}; + +package main; +my $foo = Foo->new; +my $foosub = Foo::Sub->new; +is_deeply([$foo->foo(qw(a b c))], [qw(c b a)], 'unmodified method foo'); +is($foo->bar(qw(a b c)), 'a-b-c', 'unmodified method bar'); +is_deeply([$foosub->foo(qw(a b c))], [qw(c b a d)], "foo's args are mangled (list context)"); +is(scalar $foosub->foo(qw(a b c)), 2, "foo's args are mangled (scalar context)"); +is($foosub->bar(qw(a b c)), 'a:b:c', "bar's args are mangled"); |