Integrate:

[ 23266]
[perl #31078] Fields package bug
An intermediate class with no fields messes up private fields
in the base class.

[ 23267]
I somehow managed to omit the base.pm change from #23266
p4raw-link: @23267 on //depot/perl: 446e776fb7618d56ecd9043c4060e08967abe22c
p4raw-link: @23266 on //depot/perl: 85be41ddc82ae1b92a5cc5dab5f925295b67a742

p4raw-id: //depot/maint-5.8/perl@23453
p4raw-integrated: from //depot/perl@23452 'copy in' lib/base.pm
	(@23266..)
p4raw-integrated: from //depot/perl@23266 'edit in'
	lib/base/t/fields-base.t (@23256..)

2 files changed, 56 insertions, 5 deletions

diff --git a/lib/base.pm b/lib/base.pm
index e98d0f1e61..832b6a4a9a 100644
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -152,10 +152,9 @@ sub inherit_fields {
         }
     }
 
-    unless( keys %$bfields ) {
-        foreach my $idx (1..$#{$battr}) {
-            $dattr->[$idx] = $battr->[$idx] & INHERITED;
-        }
+    foreach my $idx (1..$#{$battr}) {
+	next if defined $dattr->[$idx];
+	$dattr->[$idx] = $battr->[$idx] & INHERITED;
     }
 }
 
diff --git a/lib/base/t/fields-base.t b/lib/base/t/fields-base.t
index f4a17f5032..b633872ea1 100644
--- a/lib/base/t/fields-base.t
+++ b/lib/base/t/fields-base.t
@@ -20,7 +20,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 26;
+use Test::More tests => 27;
 
 BEGIN { use_ok('base'); }
 
@@ -218,3 +218,55 @@ package main;
     
     is ($w, 0, "pseudohash warnings in derived class with no fields of it's own");	
 }
+
+# [perl #31078] an intermediate class with no additional fields caused
+# hidden fields in base class to get stomped on
+
+{
+    package X;
+    use fields qw(X1 _X2);
+    sub new {
+	my X $self = shift;
+	$self = fields::new($self) unless ref $self;
+	$self->{X1} = "x1";
+	use Devel::Peek; Dump($self);
+	$self->{_X2} = "_x2";
+	return $self;
+    }
+    sub get_X2 { my X $self = shift; $self->{_X2} }
+
+    package Y;
+    use base qw(X);
+
+    sub new {
+	my Y $self = shift;
+	$self = fields::new($self) unless ref $self;
+	$self->SUPER::new();
+	return $self;
+    }
+
+
+    package Z;
+    use base qw(Y);
+    use fields qw(Z1);
+
+    sub new {
+	my Z $self = shift;
+	$self = fields::new($self) unless ref $self;
+	$self->SUPER::new();
+	$self->{Z1} = 'z1';
+	return $self;
+    }
+
+    package main;
+
+    if ($Has_PH) {
+	my Z $c = Z->new();
+	is($c->get_X2, '_x2', "empty intermediate class");
+    }
+    else {
+	SKIP: {
+	    skip "restricted hashes don't support private fields properly", 1;
+	}
+    }
+}