Skip Menu |
 

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

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

People
Owner: jdhedden [...] cpan.org
Requestors: mprewitt [...] flatiron.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 1.24
Fixed in: 1.26



Subject: Object::InsideOut inheritance and @main::ISA strangeness
Jerry, Thanks for the good work with Object::InsideOut. I have found a couple of problems and possible solutions. The first problem addresses extra things being put into @ISA arrays by classes using InsideOut objects. The second is with Object::InsideOut being put into the @ISA array when not always neccessary. Both problems are solved with fixes to the Object::InsideOut::import routine which I have detailed below. For the 2nd solution, I have also broke something else which I have really looked deeper into yet but thought you may have seen the error during your development cycle. So, I thought I'd send this off sooner rather than later. Thanks, Marc Prewitt 1) When using an Object::InsideOut class from main, package name of used object gets added to @main::ISA. This also happens to any @ISA in the current package if an Object::InsideOut object is used. Solution: Only do Object::InsideOut::import logic when called directly by InsideOut classes. A workaround for this is to make your Object::InsideOut class implement an import which does nothing. The following patch is a more permanent solution: diff -u -r1.1 lib/Object/InsideOut.pm --- lib/Object/InsideOut.pm 2005/12/19 15:06:41 1.1 +++ lib/Object/InsideOut.pm 2005/12/20 15:12:27 @@ -160,11 +160,13 @@ # Foreign class inheritance information my %HERITAGE; - # Doesn't export anything - just builds class trees and stores sharing flags sub import { my $self = shift; # Ourself (i.e., 'Object::InsideOut') + # don't do the ISA manipulation if we're being run as a result of a package + # just using an Object::InsideOut object (as opposed to inheriting from). + return unless $self eq __PACKAGE__; my $class = caller(); # The class that is using us no strict 'refs'; 2) When researching the above problem, I noticed that the @ISA for subclasses of InsideOut objects was not what I expected. For the following class hierarchy package t::A; { use Object::InsideOut; } package t::AA; { use Object::InsideOut qw(t::A) ; } package t::AAA; { use Object::InsideOut qw(t::AA) ; } I would expect the isa to be as follows: @t::A::ISA = ( 'Object::InsideOut' ) @t::AA::ISA = ( 't::A' ) @t::AAA::ISA = ( 't::AA' ) However, this is the actual hierarchy: @t::A::ISA = ( 'Object::InsideOut' ) @t::AA::ISA = ( 'Object::InsideOut', 't::A' ) @t::AAA::ISA = ( 'Object::InsideOut', 't::AA' ) The extra 'Object::Insideout' at the beginning of each subclass @ISA is unneccessary due to their parent class inheriting from InsideOut. There are two problems with the extra InsideOut in the ISA that I can see: - the search of the @ISA arrays may traverse Object::Inside out multiple times. - Base classes may not override Object::InsideOut methods (not sure if this is a bad or good thing.) This patch addresses this problem: diff -u -r1.1 lib/Object/InsideOut.pm --- lib/Object/InsideOut.pm 2005/12/19 15:06:41 1.1 +++ lib/Object/InsideOut.pm 2005/12/20 15:28:06 @@ -222,7 +224,9 @@ } # Create calling class's @ISA array - push(@{$class.'::ISA'}, $self); + if (!scalar @packages) { + push(@{$class.'::ISA'}, $self); + } # Create class tree my @tree; However, it breaks two other tests with the same problem: 18-inherit.t Invalid CODE attribute: Init at t/18-inherit.t line 59 19-storable.t Invalid CODE attribute: Init at t/19-storable.t line 64 Extra test cases: File: 21-import.t: use strict; use warnings; use Test::More tests => 7; package main; { use t::A; use t::B; is_deeply( \@main::ISA, [], '@main::ISA result=' . join(', ', @main::ISA)); is_deeply( \@t::A::ISA, [ 'Object::InsideOut' ], '@t::A::ISA result=' . join(', ', @t::A::ISA)); is_deeply( \@t::AA::ISA, [ 't::A' ], '@t::AA::ISA result=' . join(', ', @t::AA::ISA)); is_deeply( \@t::AAA::ISA, [ 't::AA' ], '@t::AAA::ISA result=' . join(', ', @t::AAA::ISA)); is_deeply( \@t::AA::ISA, [ 't::A' ], '@t::AA::ISA result=' . join(', ', @t::AA::ISA)); is_deeply( \@t::A_also::ISA, [ 't::A' ], '@t::A_also::ISA result=' . join(', ', @t::A_also::ISA)); is_deeply( \@t::AB::ISA, [ 't::A', 't::B' ], '@t::AB::ISA result=' . join(', ', @t::AB::ISA)); exit(0); } # multiple inheritance package t::AB; { use Object::InsideOut qw( t::A t::B ) ; } # embedded class inheritance test package t::A_also; { use Object::InsideOut qw( t::A ) ; my @foo :Field(); my %init_args :InitArgs = ( foo => {FIELD => \@foo}); sub init :Init {} } # EOF File: A.pm use strict; use warnings; package t::A; { use Object::InsideOut; # overriding import at this level will prevent users of this # class or users of child classes from getting their @ISA changed. #sub import {}; } package t::AA; { use Object::InsideOut qw(t::A) ; } package t::AAA; { use Object::InsideOut qw(t::AA) ; } 1; # EOF File: B.pm use strict; use warnings; package t::B; { use Object::InsideOut; } 1; # EOF
Download fix-mp.tar.gz
application/x-gzip-compressed 933b

Message body not shown because it is not plain text.

Download (untitled) / with headers
text/plain 2.4k
[MPREWITT - Wed Dec 21 11:50:21 2005]: Show quoted text
> 1) When using an Object::InsideOut class from main, package > name of used object gets added to @main::ISA.
'Object::InsideOut' can only get into @main::ISA if someone invokes Object::InsideOut's import() function from package 'main': package main; use Object::InsideOut; # or import Object::InsideOut; # or $obj->import(); Show quoted text
> This also happens to any @ISA in the current package if an > Object::InsideOut object is used.
Again, this would only happen with $obj->import(). I've added code to raise errors for these cases. If you can provide some sample code that demonstrates some other case, I'd appreciate it. Show quoted text
> The extra 'Object::Insideout' at the beginning of each > subclass @ISA is unneccessary due to their parent class > inheriting from InsideOut.
Good point. I've added a proper fix for this. Here's a diff for the fixes for this bug report that will be in the next release: diff -u -r1.99 InsideOut.pm --- lib/Object/InsideOut.pm 21 Dec 2005 14:55:40 -0000 1.99 +++ lib/Object/InsideOut.pm 21 Dec 2005 18:12:36 -0000 @@ -163,7 +163,16 @@ sub import { my $self = shift; # Ourself (i.e., 'Object::InsideOut') + if (Scalar::Util::blessed($self)) { + OIO::Method->die('message' => q/'import' called as an object method/); + } + my $class = caller(); # The class that is using us + if (! $class) { + OIO::Code->die( + 'message' => q/'import' invoked from 'main'/, + 'Info' => "Do not put 'use Object::InsideOut' or 'import Object::InsideOut' in application code"); + } no strict 'refs'; @@ -219,12 +228,10 @@ } } - # Create calling class's @ISA array - push(@{$class.'::ISA'}, $self); - # Create class tree my @tree; my %seen; # Used to prevent duplicate entries in @tree + my $need_oio = 1; foreach my $parent (@packages) { if (exists($TREE_TOP_DOWN{$parent})) { # Inherit from Object::InsideOut class @@ -235,6 +242,7 @@ } } push(@{$class.'::ISA'}, $parent); + $need_oio = 0; } else { # Inherit from foreign class @@ -250,6 +258,11 @@ } } + # Add Object::InsideOut to class's @ISA array, if needed + if ($need_oio) { + push(@{$class.'::ISA'}, $self); + } + # Add calling class to tree if (! exists($seen{$class})) { push(@tree, $class);
[JDHEDDEN - Wed Dec 21 13:21:04 2005]: Show quoted text
> 'Object::InsideOut' can only get into @main::ISA if someone invokes > Object::InsideOut's import() function from package 'main': > > package main; > use Object::InsideOut; > # or > import Object::InsideOut;
My error. I realize now that import() gets inherited, and that your fix was correct. Here's the revised fix in total: diff -u -r1.99 InsideOut.pm --- lib/Object/InsideOut.pm 21 Dec 2005 14:55:40 -0000 1.99 +++ lib/Object/InsideOut.pm 21 Dec 2005 18:25:40 -0000 @@ -163,7 +163,21 @@ sub import { my $self = shift; # Ourself (i.e., 'Object::InsideOut') + if (Scalar::Util::blessed($self)) { + OIO::Method->die('message' => q/'import' called as an object method/); + } + + # Invoked via inheritance - ignore + if ($self ne __PACKAGE__) { + return; + } + my $class = caller(); # The class that is using us + if (! $class) { + OIO::Code->die( + 'message' => q/'import' invoked from 'main'/, + 'Info' => "Can't use 'use Object::InsideOut;' or 'import Object::InsideOut;' inside application code"); + } no strict 'refs'; @@ -219,12 +233,10 @@ } } - # Create calling class's @ISA array - push(@{$class.'::ISA'}, $self); - # Create class tree my @tree; my %seen; # Used to prevent duplicate entries in @tree + my $need_oio = 1; foreach my $parent (@packages) { if (exists($TREE_TOP_DOWN{$parent})) { # Inherit from Object::InsideOut class @@ -235,6 +247,7 @@ } } push(@{$class.'::ISA'}, $parent); + $need_oio = 0; } else { # Inherit from foreign class @@ -250,6 +263,11 @@ } } + # Add Object::InsideOut to class's @ISA array, if needed + if ($need_oio) { + push(@{$class.'::ISA'}, $self); + } + # Add calling class to tree if (! exists($seen{$class})) { push(@tree, $class);
[JDHEDDEN - Wed Dec 21 13:51:17 2005]: Show quoted text
> 1.27 contains entire fix and tests.
Correction 1.26


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.