The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

# taken from Class::MOP's test suite, cut down to the interesting bits I haven't
# necessarily tested yet

use strict;
use warnings;

use Test::More;
use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';
my @tracelog;

package GreatGrandParent;
sub new { bless {}, shift }
sub method { 4 }
sub wrapped { push @tracelog => 'primary' }

package GrandParent;
use Class::Method::Modifiers;
our @ISA = 'GreatGrandParent';
around method => sub { (3, $_[0]->()) };

package Parent;
use Class::Method::Modifiers;
our @ISA = 'GrandParent';
around method => sub { (2, $_[0]->()) };

package Child;
use Class::Method::Modifiers;
our @ISA = 'Parent';
around method => sub { (1, $_[0]->()) };

package GrandChild;
use Class::Method::Modifiers;
our @ISA = 'Child';
around method => sub { (0, $_[0]->()) };

before wrapped => sub { push @tracelog => 'before 1' };
before wrapped => sub { push @tracelog => 'before 2' };
before wrapped => sub { push @tracelog => 'before 3' };

around wrapped => sub { push @tracelog => 'around 1'; $_[0]->() };
around wrapped => sub { push @tracelog => 'around 2'; $_[0]->() };
around wrapped => sub { push @tracelog => 'around 3'; $_[0]->() };

after wrapped => sub { push @tracelog => 'after 1' };
after wrapped => sub { push @tracelog => 'after 2' };
after wrapped => sub { push @tracelog => 'after 3' };

package main;

my $gc = GrandChild->new();
is_deeply(
    [ $gc->method() ],
    [ 0, 1, 2, 3, 4 ],
    '... got the right results back from the around methods (in list context)');

is(scalar $gc->method(), 4, '... got the right results back from the around methods (in scalar context)');

$gc->wrapped();
is_deeply(
    \@tracelog,
    [
        'before 3', 'before 2', 'before 1',  # last-in-first-out order
        'around 3', 'around 2', 'around 1',  # last-in-first-out order
        'primary',
        'after 1', 'after 2', 'after 3',     # first-in-first-out order
    ],
    '... got the right tracelog from all our before/around/after methods');


done_testing;