From b51e8730bca8f8d17a0e3ca1b6a0c0d9c966c6c1 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 27 May 2009 21:45:18 -0500 Subject: basic test of functionality --- t/001-basic.t | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 t/001-basic.t diff --git a/t/001-basic.t b/t/001-basic.t new file mode 100644 index 0000000..89bde54 --- /dev/null +++ b/t/001-basic.t @@ -0,0 +1,35 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 4; + +package Foo; +use Moose; + +sub foo { "FOO" } +sub bar { shift; join '-', @_ } + +package Foo::Sub; +use Moose; +use MooseX::Mangle; +extends 'Foo'; + +mangle_return foo => sub { + my $self = shift; + my ($foo) = @_; + return lc($foo) . 'BAR'; +}; + +mangle_args bar => sub { + my $self = shift; + my ($a, $b, $c) = @_; + return ($b, $c, $a); +}; + +package main; +my $foo = Foo->new; +my $foosub = Foo::Sub->new; +is($foo->foo, 'FOO', 'unmodified method foo'); +is($foo->bar('a', 'b', 'c'), 'a-b-c', 'unmodified method bar'); +is($foosub->foo, 'fooBAR', "foo's return is mangled"); +is($foosub->bar('a', 'b', 'c'), 'b-c-a', "bar's args are mangled"); -- cgit v1.2.3-54-g00ecf