From a8f3de3d9e8c11aa5f21a5f0c4c7f5dc748109e2 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 27 May 2009 23:06:40 -0500 Subject: tests for mangle_args and mangle_return --- t/010-mangle-args.t | 41 +++++++++++++++++++++++++++++++++++++++++ t/011-mangle-return.t | 44 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 85 insertions(+) create mode 100644 t/010-mangle-args.t create mode 100644 t/011-mangle-return.t 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"); -- cgit v1.2.3-54-g00ecf