| Subject: | Problem with foreign inheritance of a class that overrides 'bool' |
perl -v:
This is perl, v5.8.6 built for darwin-thread-multi-2level
Foreign inheritance of an object that overloads 'bool' fails.
Given a package:
package Morsulus::Catalog::SetOf;
use strict;
use warnings;
use Object::InsideOut qw/ Set::Scalar::Valued /;
{
my @the_sets :Field :Get('_get_the_set');
sub _init :Init
{
my $self = shift;
my $args = shift;
my $the_set = Set::Scalar::Valued->new();
$self->set(\@the_sets, $the_set);
$self->inherit($the_set, $args);
}
}
1;
an attempt to create an object in this class dies with the error:
died: OIO::Args error: Missing arg(s) to '->inherit()'
Set::Scalar overloads 'bool' such that an empty set tests as false.
In Object::InsideOut::Foreign, the inherit subroutine gets bitten
by this when it tries to do 'while (my $arg = shift)...' to flatten
the argument list. If @_ contains an empty Set::Scalar, the loop
exits without capturing the value, causing the above error message.
I've sent a unified diff on Foreign.pm plus a new test file to the
author. I'll repeat them here.
The unified diff:
--- Foreign.pm.orig 2007-03-25 13:27:41.000000000 -0400
+++ Foreign.pm 2007-03-25 13:28:58.000000000 -0400
@@ -31,7 +31,7 @@
# Flatten arg list
my @arg_objs;
- while (my $arg = shift) {
+ while (defined my $arg = shift) {
if (ref($arg) eq 'ARRAY') {
push(@arg_objs, @{$arg});
} else {
The new test, 18a-inherit.t:
use strict;
use warnings;
use Test::More tests => 1;
# Borg is a foreign hash-based class that overloads bool
package Borg;
{
use overload 'bool' => \&bool;
sub new {
my $class = shift;
my %self = @_;
return ( bless( \%self, $class ) );
}
sub get_borg {
my ( $self, $data ) = @_;
return ( $self->{$data} );
}
sub set_borg {
my ( $self, $key, $value ) = @_;
$self->{$key} = $value;
}
sub warn {
return ('Resistance is futile');
}
sub bool { my $self = shift; return scalar keys %$self; }
}
package Foo;
{
use Object::InsideOut qw(Borg);
my @objs : Field('Acc'=>'obj', 'Type' => 'list');
my %init_args : InitArgs = (
'OBJ' => {
'RE' => qr/^obj$/i,
'Field' => \@objs,
'Type' => 'list',
},
'BORG' => { 'RE' => qr/^borg$/i, }
);
sub init : Init {
my ( $self, $args ) = @_;
$self->inherit( Borg->new() );
if ( exists( $args->{'BORG'} ) ) {
$self->set_borg( 'borg' => $args->{'BORG'} );
}
}
}
package main;
MAIN:
{
eval { my $obj = Foo->new(); };
ok( $@ eq '', 'Created object with overloaded bool operation' );
}
exit(0);
# EOF
The new test was based on the existing test for inherit.
3.12 failed the new test; my patch caused it to pass.