t/017_wrapped_method_context_propagation.t

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