| Subject: | Infinite recursion on hierarchies four or more deep |
Hierarchies four or more deep end up in inifinte recusrion, this is
because of the way that SUPER.pm prunes the hierarchy list. It doesn't
prune everything below the "current" level, but only the current level.
There are a number of ways that this may be fixed, I'm not sure what the
best one is.
Attached is a test file that fails. Well, it fails in the sense it
doesn't exit so Test::Harness will report extra non-exiting tests as
failures. Maybe there's a better way to test for infinite recursion.
Attached is also a patch of *one* possible fix.
| Subject: | deep_inheritance.t |
#!/usr/bin/perl -w
BEGIN
{
chdir 't' if -d 't';
}
use lib '../lib';
use strict;
use Test::More tests => 15;
use Scalar::Util qw/blessed/;
my $module = 'SUPER';
use_ok($module) or die;
my $obj = Level4->new;
isa_ok($obj, 'Level4');
is($obj->good_stuff, "this has done good stuff", '...the object is initialised as level4');
my @parents = SUPER::get_all_parents($obj, blessed($obj));
is_deeply(\@parents, [qw/Level3 Level2 Level1 UNIVERSAL/], '...the object has four parents from its own class.');
@parents = SUPER::get_all_parents($obj, 'Level3');
is_deeply(\@parents, [qw/Level2 Level1 UNIVERSAL/], '...3 parents from one class above.');
@parents = SUPER::get_all_parents($obj, 'Level2');
is_deeply(\@parents, [qw/Level1 UNIVERSAL/], '...2 parents from two classes above.');
@parents = SUPER::get_all_parents($obj, 'Level1');
is_deeply(\@parents, [qw/UNIVERSAL/], '...and only UNIVERSAL from the top level class.');
my ($sub, $parent) = SUPER::find_parent( blessed($obj), 'good_stuff', 'Level4', $obj );
is($sub, \&Level3::good_stuff, '...get the expected superclass method.');
is($parent, 'Level3', '...in the expected superclass.');
($sub, $parent) = SUPER::find_parent( blessed($obj), 'good_stuff', 'Level3', $obj );
is($sub, \&Level2::good_stuff, '...get the expected superclass method one up.');
is($parent, 'Level2', '...in the superclass one up.');
($sub, $parent) = SUPER::find_parent( blessed($obj), 'good_stuff', 'Level2', $obj );
is($sub, \&Level1::good_stuff, '...get the expected superclass method two up.');
is($parent, 'Level1', '...in the superclass two up.');
($sub, $parent) = SUPER::find_parent( blessed($obj), 'good_stuff', 'Level1', $obj );
is($sub, '', '...get an empty string when there are no more super class.');
is($parent, undef, '...and undef when no further superclasses match the desired method.');
exit;
package Level1;
sub new { bless {}, $_[0]};
sub good_stuff { return "this has done good stuff" };
package Level2;
use base 'Level1';
sub good_stuff { $_[0]->SUPER;}
package Level3;
use base 'Level2';
sub good_stuff { $_[0]->SUPER;}
package Level4;
use base 'Level3';
| Subject: | super-diff-norecurse.dif |
Message body not shown because it is not plain text.