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 (file)
--- 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 (file)
--- 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 (file)
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