Skip Menu |
 

This queue is for tickets about the Object-InsideOut CPAN distribution.

Report information
The Basics
Id: 25787
Status: resolved
Priority: 0/
Queue: Object-InsideOut

People
Owner: Nobody in particular
Requestors: herveus [...] radix.net
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 3.12
Fixed in: (no value)



Subject: Problem with foreign inheritance of a class that overrides 'bool'
Download (untitled) / with headers
text/plain 2.7k
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.
Thanks for the patch. Applied in 3.14 along with the same fix to the disinherit function.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.