From: Dave Mitchell <davem@fdisolutions.com>
Date: Sun, 5 Sep 2004 20:04:35 +0000 (+0000)
Subject: [perl #31078] Fields package bug
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=85be41ddc82ae1b92a5cc5dab5f925295b67a742;p=p5sagit%2Fp5-mst-13.2.git

[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
--- 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;
+	}
+    }
+}