#!/usr/bin/perl -w

BEGIN
{
	chdir 't' if -d 't';
}

use lib '../lib';

use strict;
use Test::More tests => 15;
use Scalar::Util 'blessed';

my $module = 'SUPER';
use_ok($module) or die;

my $obj = Level4->new;
isa_ok( $obj, 'Level4' );

is( $obj->good_stuff, 'this has done good stuff',
	'...the object is initialized as level4'
);

my @parents = SUPER::get_all_parents( $obj, blessed($obj) );
is_deeply( \@parents, [qw( Level3 Level2 Level1 UNIVERSAL )],
	'...the object has four parents from its own class.'
);

@parents = SUPER::get_all_parents( $obj, 'Level3' );
is_deeply( \@parents, [qw( Level2 Level1 UNIVERSAL )],
	'... 3 parents from one class above.'
);

@parents = SUPER::get_all_parents( $obj, 'Level2' );
is_deeply( \@parents, [qw( Level1 UNIVERSAL )],
	'...2 parents from two classes above.' );

@parents = SUPER::get_all_parents( $obj, 'Level1' );
is_deeply( \@parents, [ 'UNIVERSAL' ],
	'...and only UNIVERSAL from the top level class.' );

my ( $sub, $parent ) =
	SUPER::find_parent( blessed($obj), 'good_stuff', 'Level4', $obj );
is( $sub, \&Level3::good_stuff, '...get the expected superclass method.' );
is( $parent, 'Level3', '...in the expected superclass.' );

( $sub, $parent ) =
	SUPER::find_parent( blessed($obj), 'good_stuff', 'Level3', $obj );
is( $sub, \&Level2::good_stuff,
	'...get the expected superclass method one up.' );
is( $parent, 'Level2', '...in the superclass one up.' );

( $sub, $parent ) =
	SUPER::find_parent( blessed($obj), 'good_stuff', 'Level2', $obj );
is( $sub, \&Level1::good_stuff,
	'...get the expected superclass method two up.' );
is( $parent, 'Level1', '...in the superclass two up.' );

( $sub, $parent ) =
	SUPER::find_parent( blessed($obj), 'good_stuff', 'Level1', $obj );
is( $sub, '', '...get an empty string when there are no more super class.' );
is( $parent, undef,
	'...and undef when no further superclasses match the desired method.' );

exit;

package Level1;

sub new { bless {}, $_[0] }

sub good_stuff { return "this has done good stuff" }

package Level2;

use base 'Level1';

sub good_stuff { $_[0]->SUPER; }

package Level3;

use base 'Level2';

sub good_stuff { $_[0]->SUPER; }

package Level4;

use base 'Level3';