[perl #24942] fields::inherit doesn't bless derived

    package's \%FIELDS, results in phash deprecation errors. 
From:  "nothingmuch@woobling.org (via RT)" <perlbug-followup@perl.org>
Message-Id:  <rt-3.0.8-24942-70144.16.7177902690315@perl.org>

p4raw-id: //depot/perl@22208

2 files changed, 45 insertions, 6 deletions

diff --git a/lib/base.pm b/lib/base.pm
index 04a8aa961e..b735848f9b 100644
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -38,11 +38,26 @@ sub get_attr {
     return $Fattr->{$_[0]};
 }
 
-sub get_fields {
-    # Shut up a possible typo warning.
-    () = \%{$_[0].'::FIELDS'};
-
-    return \%{$_[0].'::FIELDS'};
+if ($] < 5.009) {
+    *get_fields = sub {
+	# Shut up a possible typo warning.
+	() = \%{$_[0].'::FIELDS'};
+	my $f = \%{$_[0].'::FIELDS'};
+
+	# should be centralized in fields? perhaps
+	# fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
+	# is used here anyway, it doesn't matter.
+	bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
+
+	return $f;
+    }
+}
+else {
+    *get_fields = sub {
+	# Shut up a possible typo warning.
+	() = \%{$_[0].'::FIELDS'};
+	return \%{$_[0].'::FIELDS'};
+    }
 }
 
 sub import {
diff --git a/lib/base/t/fields-base.t b/lib/base/t/fields-base.t
index b5ab54f7cb..f4a17f5032 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 => 25;
+use Test::More tests => 26;
 
 BEGIN { use_ok('base'); }
 
@@ -194,3 +194,27 @@ eval {
 ::like( $@, qr/Can't multiply inherit %FIELDS/i, 'Again, no multi inherit' );
 
 
+# Test that a package with no fields can inherit from a package with
+# fields, and that pseudohash messages don't show up
+
+package B9;
+use fields qw(b1);
+
+sub _mk_obj { fields::new($_[0])->{'b1'} };
+
+package D9;
+use base qw(B9);
+
+package main;
+
+{
+    my $w = 0;
+    local $SIG{__WARN__} = sub { $w++ };
+    
+    B9->_mk_obj();
+    # used tp emit a warning that pseudohashes are deprecated, because
+    # %FIELDS wasn't blessed.
+    D9->_mk_obj();
+    
+    is ($w, 0, "pseudohash warnings in derived class with no fields of it's own");	
+}