Commit | Line | Data |
60ad2cb7 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
9864f0e4 |
6 | use Test::More tests => 7; |
7 | |
60ad2cb7 |
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 | |