t/010_basics/008_wrapped_method_cxt_propagation.t

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