From: Michael G. Schwern <schwern@pobox.com>
Date: Wed, 19 Sep 2007 00:39:40 +0000 (-0700)
Subject: Re: [PATCH] Re: Unintentional base.pm behavior change
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=00ed247ad44f2548d0ea02a06b0a1bb418a1c315;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] Re: Unintentional base.pm behavior change
Message-ID: <46F0D23C.6020105@pobox.com>

p4raw-id: //depot/perl@31895
---

diff --git a/MANIFEST b/MANIFEST
index 172d580..40d7911 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1450,6 +1450,7 @@ lib/base.pm			Establish IS-A relationship at compile time
 lib/base/t/base.t		See if base works
 lib/base/t/fields-base.t	See if fields work
 lib/base/t/fields.t		See if fields work
+lib/base/t/isa.t		See if base's behaviour doesn't change
 lib/base/t/sigdie.t		See if base works with SIGDIE
 lib/base/t/version.t		See if base works with versions
 lib/base/t/warnings.t		See if base works with warnings
diff --git a/lib/base.pm b/lib/base.pm
index fc0f7f9..abbacb6 100644
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -71,12 +71,13 @@ sub import {
     my $inheritor = caller(0);
     my @isa_classes;
 
+    my @bases;
     foreach my $base (@_) {
         if ( $inheritor eq $base ) {
             warn "Class '$inheritor' tried to inherit from itself\n";
         }
 
-        next if $inheritor->isa($base);
+        next if grep $_->isa($base), ($inheritor, @bases);
 
         if (has_version($base)) {
             ${$base.'::VERSION'} = '-1, set by base.pm' 
@@ -106,7 +107,7 @@ ERROR
             ${$base.'::VERSION'} = "-1, set by base.pm"
               unless defined ${$base.'::VERSION'};
         }
-        push @isa_classes, $base;
+        push @bases, $base;
 
         if ( has_fields($base) || has_attr($base) ) {
             # No multiple fields inheritance *suck*
@@ -121,6 +122,8 @@ ERROR
     # Save this until the end so it's all or nothing if the above loop croaks.
     push @{"$inheritor\::ISA"}, @isa_classes;
 
+    push @{"$inheritor\::ISA"}, @bases;
+
     if( defined $fields_base ) {
         inherit_fields($inheritor, $fields_base);
     }
diff --git a/lib/base/t/isa.t b/lib/base/t/isa.t
new file mode 100644
index 0000000..efe3386
--- /dev/null
+++ b/lib/base/t/isa.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl -w
+
+# Regression test some quirky behavior of base.pm.
+
+BEGIN {
+   if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+use strict;
+use Test::More tests => 1;
+
+{
+    package Parent;
+
+    sub foo { 42 }
+
+    package Middle;
+
+    use base qw(Parent);
+
+    package Child;
+
+    base->import(qw(Middle Parent));
+}
+
+is_deeply [@Child::ISA], [qw(Middle)],
+          'base.pm will not add to @ISA if you already are-a';
\ No newline at end of file