From: Rick Delaney <rick@consumercontact.com>
Date: Wed, 5 Sep 2007 14:38:40 +0000 (-0400)
Subject: Re: [perl #44969] Restricted hashes do not handle private fields properly
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5f0a87760bb9130fbd7579236f81db0729b54496;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #44969] Restricted hashes do not handle private fields properly
Message-ID: <20070905183840.GE9260@bort.ca>

p4raw-id: //depot/perl@31797
---

diff --git a/lib/base/t/fields-base.t b/lib/base/t/fields-base.t
index 0ec12c2..d3e8c7b 100644
--- a/lib/base/t/fields-base.t
+++ b/lib/base/t/fields-base.t
@@ -245,11 +245,6 @@ package main;
 	my X $self = shift;
 	$self = fields::new($self) unless ref $self;
 	$self->{X1} = "x1";
-	# FIXME. This code is dead on blead becase the test is skipped.
-	# The test states that it's being skipped becaues restricted hashes
-	# don't support a feature. Presumably we need to make that feature
-	# supported. Bah.
-	# use Devel::Peek; Dump($self);
 	$self->{_X2} = "_x2";
 	return $self;
     }
@@ -280,13 +275,6 @@ package main;
 
     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;
-	}
-    }
 }
diff --git a/lib/fields.pm b/lib/fields.pm
index 44a68c5..61f02a2 100644
--- a/lib/fields.pm
+++ b/lib/fields.pm
@@ -11,7 +11,7 @@ unless( eval q{require warnings::register; warnings::register->import; 1} ) {
 }
 use vars qw(%attr $VERSION);
 
-$VERSION = '2.12';
+$VERSION = '2.13';
 
 # constant.pm is slow
 sub PUBLIC     () { 2**0  }
@@ -124,11 +124,19 @@ if ($] < 5.009) {
     my $self = bless {}, $class;
 
     # The lock_keys() prototype won't work since we require Hash::Util :(
-    &Hash::Util::lock_keys(\%$self, keys %{$class.'::FIELDS'});
+    &Hash::Util::lock_keys(\%$self, _accessible_keys($class));
     return $self;
   }
 }
 
+sub _accessible_keys {
+    my ($class) = @_;
+    return (
+        keys %{$class.'::FIELDS'},
+        map(_accessible_keys($_), @{$class.'::ISA'}),
+    );
+}
+
 sub phash {
     die "Pseudo-hashes have been removed from Perl" if $] >= 5.009;
     my $h;