From 00ed247ad44f2548d0ea02a06b0a1bb418a1c315 Mon Sep 17 00:00:00 2001 From: "Michael G. Schwern" Date: Tue, 18 Sep 2007 17:39:40 -0700 Subject: [PATCH] Re: [PATCH] Re: Unintentional base.pm behavior change Message-ID: <46F0D23C.6020105@pobox.com> p4raw-id: //depot/perl@31895 --- MANIFEST | 1 + lib/base.pm | 7 +++++-- lib/base/t/isa.t | 30 ++++++++++++++++++++++++++++++ 3 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 lib/base/t/isa.t 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 -- 2.7.4