[perl #31078] Fields package bug

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

p4raw-id: //depot/perl@23266

diff --git a/lib/base/t/fields-base.t b/lib/base/t/fields-base.t
index 491279f..04661c5 100644 (file)
--- 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;
+       }
+    }
+}