[dbsrgits/DBIx-Class.git] / t / 04dont_break_c3.t

#!/usr/bin/perl -w
#Simon Ilyushchenko, 12/05/05
#Testing the case when we try to inject into @ISA a class that's already a parent of the target class.

use strict;
use Test::More tests => 2;
use MRO::Compat;

{
package AAA;

use base "DBIx::Class::Core";

package BBB;

use base 'AAA';

#Injecting a direct parent.
__PACKAGE__->inject_base( __PACKAGE__, 'AAA' );


package CCC;

use base 'AAA';

#Injecting an indirect parent.
__PACKAGE__->inject_base( __PACKAGE__, 'DBIx::Class::Core' );
}

eval { mro::get_linear_isa('BBB'); };
ok (! $@, "Correctly skipped injecting a direct parent of class BBB");

eval { mro::get_linear_isa('CCC'); };
ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");
Commit	Line	Data
e4c24739	1	#!/usr/bin/perl -w
	2	#Simon Ilyushchenko, 12/05/05
	3	#Testing the case when we try to inject into @ISA a class that's already a parent of the target class.
	4
	5	use strict;
	6	use Test::More tests => 2;
4f507947	7	use MRO::Compat;
e4c24739	8
	9	{
	10	package AAA;
	11
	12	use base "DBIx::Class::Core";
	13
	14	package BBB;
	15
	16	use base 'AAA';
	17
	18	#Injecting a direct parent.
	19	__PACKAGE__->inject_base( __PACKAGE__, 'AAA' );
	20
	21
	22	package CCC;
	23
	24	use base 'AAA';
	25
	26	#Injecting an indirect parent.
	27	__PACKAGE__->inject_base( __PACKAGE__, 'DBIx::Class::Core' );
	28	}
	29
4f507947	30	eval { mro::get_linear_isa('BBB'); };
e4c24739	31	ok (! $@, "Correctly skipped injecting a direct parent of class BBB");
e4c24739	32
4f507947	33	eval { mro::get_linear_isa('CCC'); };
e4c24739	34	ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");