[Dbix-class] Patch for inject_base

[Vsevolod (Simon) Ilyushchenko]

Matt,

Here you go. A test case and a better patch (checks for both direct and 
indirect parent, not just direct ones).

Simon

Matt S Trout wrote on 12/02/2005 09:41 PM:
> On Wed, Nov 30, 2005 at 07:24:29PM -0500, Vsevolod (Simon) Ilyushchenko wrote:
> 
>>Matt,
>>
>>I've found that when for some reason the same class is passed twice to 
>>the hierarchy, Class::C3 complains. To fix this, I suggest the following 
>>patch:
>>
>>--- lib/DBIx/Class/Componentised.pm     2005-11-26 18:26:14.000000000 -0500
>>+++ /opt/software/perl/lib/DBIx/Class/Componentised.pm  2005-11-30 
>>18:46:11.000000000 -0500
>>@@ -6,7 +6,8 @@
>>   my ($class, $target, @to_inject) = @_;
>>   {
>>     no strict 'refs';
>>-    unshift(@{"${target}::ISA"}, grep { $target ne $_ } @to_inject);
>>+    my %isa = map {$_=>1} @{"${target}::ISA"};
>>+    unshift(@{"${target}::ISA"}, grep { $target ne $_ && !$isa{$_}} 
>>@to_inject);
>>   }
>>   my $table = { Class::C3::_dump_MRO_table };
>>   eval "package $target; import Class::C3;" unless exists 
>>$table->{$target};
> 
> 
> I'd be happy to commit this, but is there any chance of a test case as well,
> please?
> 

-- 

Simon (Vsevolod ILyushchenko)   simonf at cshl.edu
				http://www.simonf.com

"Think like a man of action, act like a man of thought."

		         Henri Bergson
-------------- next part --------------
--- Componentised.pm	2005-11-26 18:26:14.000000000 -0500
+++ /opt/software/perl/lib/DBIx/Class/Componentised.pm	2005-12-05 19:56:32.000000000 -0500
@@ -6,7 +6,7 @@
   my ($class, $target, @to_inject) = @_;
   {
     no strict 'refs';
-    unshift(@{"${target}::ISA"}, grep { $target ne $_ } @to_inject);
+    unshift(@{"${target}::ISA"}, grep { $target ne $_ && !$target->isa($_)} @to_inject);
   }
   my $table = { Class::C3::_dump_MRO_table };
   eval "package $target; import Class::C3;" unless exists $table->{$target};
-------------- next part --------------
#!/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;

{
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 { Class::C3::calculateMRO('BBB'); };
ok (! $@, "Correctly skipped injecting a direct parent of class BBB");

eval { Class::C3::calculateMRO('CCC'); };
ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");