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