Skip to content

Commit 8731c5d

Browse files
nothingmuchDave Mitchell
authored and
Dave Mitchell
committed
[perl #24942] fields::inherit doesn't bless derived
package's \%FIELDS, results in phash deprecation errors. From: "[email protected] (via RT)" <[email protected]> Message-Id: <[email protected]> p4raw-id: //depot/perl@22208
1 parent 6eb87ff commit 8731c5d

File tree

2 files changed

+45
-6
lines changed

2 files changed

+45
-6
lines changed

lib/base.pm

Lines changed: 20 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -38,11 +38,26 @@ sub get_attr {
3838
return $Fattr->{$_[0]};
3939
}
4040

41-
sub get_fields {
42-
# Shut up a possible typo warning.
43-
() = \%{$_[0].'::FIELDS'};
44-
45-
return \%{$_[0].'::FIELDS'};
41+
if ($] < 5.009) {
42+
*get_fields = sub {
43+
# Shut up a possible typo warning.
44+
() = \%{$_[0].'::FIELDS'};
45+
my $f = \%{$_[0].'::FIELDS'};
46+
47+
# should be centralized in fields? perhaps
48+
# fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
49+
# is used here anyway, it doesn't matter.
50+
bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
51+
52+
return $f;
53+
}
54+
}
55+
else {
56+
*get_fields = sub {
57+
# Shut up a possible typo warning.
58+
() = \%{$_[0].'::FIELDS'};
59+
return \%{$_[0].'::FIELDS'};
60+
}
4661
}
4762

4863
sub import {

lib/base/t/fields-base.t

Lines changed: 25 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ BEGIN {
2020
}
2121

2222
use strict;
23-
use Test::More tests => 25;
23+
use Test::More tests => 26;
2424

2525
BEGIN { use_ok('base'); }
2626

@@ -194,3 +194,27 @@ eval {
194194
::like( $@, qr/Can't multiply inherit %FIELDS/i, 'Again, no multi inherit' );
195195

196196

197+
# Test that a package with no fields can inherit from a package with
198+
# fields, and that pseudohash messages don't show up
199+
200+
package B9;
201+
use fields qw(b1);
202+
203+
sub _mk_obj { fields::new($_[0])->{'b1'} };
204+
205+
package D9;
206+
use base qw(B9);
207+
208+
package main;
209+
210+
{
211+
my $w = 0;
212+
local $SIG{__WARN__} = sub { $w++ };
213+
214+
B9->_mk_obj();
215+
# used tp emit a warning that pseudohashes are deprecated, because
216+
# %FIELDS wasn't blessed.
217+
D9->_mk_obj();
218+
219+
is ($w, 0, "pseudohash warnings in derived class with no fields of it's own");
220+
}

0 commit comments

Comments
 (0)