| Subject: | Error in _init on rebless of restricted hash |
Class-Struct-FIELDS-1.1
{
package X;
use Class::Struct::FIELDS { 'a' => '$' }
}
X::->new;
results in :
Modification of a read-only value attempted at (eval 3) line 48.
The generate _init functions tries to rebless the object. But in 5.9 and
above, the object is a restricted hash - which may not be reblessed.
Patch is attached.
The patch also cleans up some other initialization problems, including
multiple initialization of base class fields.
| Subject: | rebless_fix.patch |
35,36d34
< sub DEBUG { 0; }
<
156,157c154
< eval _mini_prolog($class, $isa);
<
---
> eval _mini_prolog ($class, $isa); # baseclass warnings
167,168d163
< warn "$class working on $k\n" if DEBUG();
<
189,190c184,185
< # Depends on _mini_prolog to make sure that our ISA is set up.
< _baseclass_warning ($class, $k) if $class->UNIVERSAL::can ($k);
---
> # This doesn't work? XXX
> _baseclass_warning ($class, $k) if UNIVERSAL::can ($class, $k);
287d281
< #print $eval, "\n";
340,343c334
< # base adds to @ISA, so no need to go through hoops
< # to make sure we grab any current settings.
< #my @isa = _get_isa ($class, $isa);
< my @isa = @$isa;
---
> my @isa = _get_isa ($class, $isa);
355,359c346
< # base adds to @ISA, so no need to go through hoops
< # to make sure we grab any current settings.
< #my @isa = _get_isa ($class, $isa);
< my @isa = @$isa;
< warn "$class isa = @isa\n" if DEBUG();
---
> my @isa = _get_isa ($class, $isa);
372c359
< use base qw(@isa);
---
> use base qw(@isa);
375,376d361
< our \$DEBUG = Class::Struct::FIELDS::DEBUG();
<
398d382
< warn "$class :: _init called\n" if \$DEBUG;
401c385
< # Simple solution for now.
---
> # Simple solution for now. Some problems:
403c387
< # Diamond inheritance can call _init multiple times. I don't
---
> # 1. Diamond inheritance can call _init multiple times. I don't
405a390,391
> #
> # 2. Member initialization gets called every time through.
407,417c393,394
< for my \$b (qw(@isa)) {
< # Base class might not be from Class::Struct::FIELDS.
< # Check for ability to handle the call. Still, this is dangerous.
< # There might be an unrelated _init that doesn't play nice
< # (e.g. return \$self);
< # Should there be an earlier check to forbid? XXXX
< if (\$b->can('_init')) {
< my \$func = "\${b}::_init";
< warn "$class is calling to \$b :: _init\n" if \$DEBUG;
< \$self = \$self->\$func(\@_);
< }
---
> for (qw(@isa)) {
> eval { bless \$self, \$_; \$self = \$self->_init (\@_) };
419a397,398
> bless \$self, qw($class);
>
429,432c408
< foreach my \$f (qw{@fields}) {
< warn "$class setting \$f\n" if \$DEBUG;
< \$self->\$f(\$init{\$f}) if exists \$init{\$f};
< }
---
> my \$c;
433a410,412
> while (my (\$k, \$v) = each \%init) {
> \$self->\$c (\$v) if \$c = $class\::->can (\$k);
> }
436,439c415
< # Don't use a OO type call since that will recurse through the
< # \@ISA heirarchy. Calling a base class's init multiple times is
< # not desired. Lock it down to only calling the init in our package.
< eval { \$self = ${class}::init(\$self, \@_) };
---
> eval { \$self = \$self->init (\@_) }; # if \$self->can ('init');
443,462d418
<
< #
< # Convenience function to set the values for a list of fields.
< # This takes an array so that we can preserve the ordering, if that
< # is important to the client. Obviously, if they pass us a hash,
< # we'll do it in the order perl gives it to us. But if they pass an
< # an array, we'll preserve order. Most of the time, this won't matter.
< #
< sub set {
< my $class \$self = shift;
< my \@params = \@_;
< croak "Odd number of elements in initializer" if \@params % 2;
< while (\@params) {
< my \$k = shift;
< my \$v = shift;
< my \$c;
< \$self->\$c (\$v) if \$c = $class\::->can (\$k);
< }
< }
<
1515c1471
< The most straight forward way to do this and still retain C<strict>
---
> The most straight forward way to do this and still retain C<string>