[perl #31078] Fields package bug

An intermediate class with no fields messes up private fields
in the base class.

p4raw-id: //depot/perl@23266

1 files changed, 53 insertions, 1 deletions

diff --git a/lib/base/t/fields-base.t b/lib/base/t/fields-base.t
index 491279f9f7..04661c53d6 100644
--- a/lib/base/t/fields-base.t
+++ b/lib/base/t/fields-base.t
@@ -21,7 +21,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 28;
+use Test::More tests => 29;
 
 BEGIN { use_ok('base'); }
 
@@ -224,3 +224,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;
+	}
+    }
+}