| 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
Message body not shown because it is not plain text.