From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sun, 18 Jun 2006 12:09:17 +0000 (+0000)
Subject: Test that simple contexts are passed to wrapped methods
X-Git-Tag: 0_09_03~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f1cfdc6453485582df1676c8fe14db06f42955d8;p=gitmo%2FMoose.git

Test that simple contexts are passed to wrapped methods
---

diff --git a/t/017_wrapped_method_context_propagation.t b/t/017_wrapped_method_context_propagation.t
new file mode 100644
index 0000000..85750e1
--- /dev/null
+++ b/t/017_wrapped_method_context_propagation.t
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+BEGIN {
+    use_ok('Moose');
+}
+
+{
+    package TouchyBase;
+    use Moose;
+
+    has string_ref => ( is => 'rw', default => sub { my $x = "moose fruit"; \$x } );
+    has x => ( is => 'rw', default => 0 );
+
+    sub inc { $_[0]->x( 1 + $_[0]->x ) }
+
+    sub scalar_or_array {
+        wantarray ? (qw/a b c/) : "x";
+    }
+
+    sub array_arity {
+        split(/\s+/,"foo bar gorch baz la");
+    }
+
+    sub void {
+        die "this must be void context" if defined wantarray;
+    }
+
+    sub substr_lvalue : lvalue {
+        my $self = shift;
+        my $string_ref = $self->string_ref;
+        my $lvalue_ref = \substr($$string_ref, 0, 5);
+        $$lvalue_ref;
+    }
+
+    package AfterSub;
+    use Moose;
+
+    extends "TouchyBase";
+
+    after qw/scalar_or_array array_arity void substr_lvalue/ => 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)" );
+    }
+}
+