t/017_wrapped_method_context_propagation.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 7;
   7
   8 BEGIN {
   9     use_ok('Moose');
  10 }
  11
  12 {
  13     package TouchyBase;
  14     use Moose;
  15
  16     has string_ref => ( is => 'rw', default => sub { my $x = "moose fruit"; \$x } );
  17     has x => ( is => 'rw', default => 0 );
  18
  19     sub inc { $_[0]->x( 1 + $_[0]->x ) }
  20
  21     sub scalar_or_array {
  22         wantarray ? (qw/a b c/) : "x";
  23     }
  24
  25     sub array_arity {
  26         split(/\s+/,"foo bar gorch baz la");
  27     }
  28
  29     sub void {
  30         die "this must be void context" if defined wantarray;
  31     }
  32
  33     sub substr_lvalue : lvalue {
  34         my $self = shift;
  35         my $string_ref = $self->string_ref;
  36         my $lvalue_ref = \substr($$string_ref, 0, 5);
  37         $$lvalue_ref;
  38     }
  39
  40     package AfterSub;
  41     use Moose;
  42
  43     extends "TouchyBase";
  44
  45     after qw/scalar_or_array array_arity void substr_lvalue/ => sub {
  46         my $self = shift;
  47         $self->inc;
  48     }
  49 }
  50
  51 my $base = TouchyBase->new;
  52 my $after = AfterSub->new;
  53
  54 foreach my $obj ( $base, $after ) {
  55     my $class = ref $obj;
  56     my @array = $obj->scalar_or_array;
  57     my $scalar = $obj->scalar_or_array;
  58
  59     is_deeply(\@array, [qw/a b c/], "array context ($class)");
  60     is($scalar, "x", "scalar context ($class)");
  61
  62     {
  63         local $@;
  64         eval { $obj->void };
  65         ok( !$@, "void context ($class)" );
  66     }
  67 }
  68