t/010_basics/008_wrapped_method_cxt_propagation.t

   1 #!/usr/bin/perl
   2 # This is automatically generated by author/import-moose-test.pl.
   3 # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
   4 use t::lib::MooseCompat;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Test::More;
  10
  11
  12 {
  13     package TouchyBase;
  14     use Mouse;
  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 Mouse;
  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
  61 done_testing;