Import Moose/t/010_basics/*.t

[gitmo/Mouse.git] / t / 010_basics / 008_wrapped_method_cxt_propagation.t

diff --git a/t/010_basics/008_wrapped_method_cxt_propagation.t b/t/010_basics/008_wrapped_method_cxt_propagation.t
new file mode 100755 (executable)
index 0000000..664b187
--- /dev/null
+++ b/t/010_basics/008_wrapped_method_cxt_propagation.t
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+
+
+{
+    package TouchyBase;
+    use Mouse;
+
+    has x => ( is => 'rw', default => 0 );
+
+    sub inc { $_[0]->x( 1 + $_[0]->x ) }
+
+    sub scalar_or_array {
+        wantarray ? (qw/a b c/) : "x";
+    }
+
+    sub void {
+        die "this must be void context" if defined wantarray;
+    }
+
+    package AfterSub;
+    use Mouse;
+
+    extends "TouchyBase";
+
+    after qw/scalar_or_array void/ => sub {
+        my $self = shift;
+        $self->inc;
+    }
+}
+
+my $base = TouchyBase->new;
+my $after = AfterSub->new;
+
+foreach my $obj ( $base, $after ) {
+    my $class = ref $obj;
+    my @array = $obj->scalar_or_array;
+    my $scalar = $obj->scalar_or_array;
+
+    is_deeply(\@array, [qw/a b c/], "array context ($class)");
+    is($scalar, "x", "scalar context ($class)");
+
+    {
+        local $@;
+        eval { $obj->void };
+        ok( !$@, "void context ($class)" );
+    }
+
+    if ( $obj->isa("AfterSub") ) {
+        is( $obj->x, 3, "methods were wrapped" );
+    }
+}
+