our $VERSION = '0.01';
-sub _fetcher {
- my ($root, $_parent_fetcher) = @_;
-
- my $parent_fetcher = $_parent_fetcher;
- unless (ref($parent_fetcher) && ref($parent_fetcher) eq 'CODE') {
- $parent_fetcher = $root->can($_parent_fetcher)
- || confess "Could not find method $_parent_fetcher in $root";
- }
- [ $parent_fetcher->($root) ];
-}
-
sub merge {
my ($root, $parent_fetcher) = @_;
my %fcache; # cache of _fetcher results
my %mcache; # cache of merge do-block results
+ my $pfetcher_is_coderef = ref($parent_fetcher) eq 'CODE';
+
+ unless ($pfetcher_is_coderef or $root->can($parent_fetcher)) {
+ confess "Could not find method $parent_fetcher in $root";
+ }
+
my $current_root = $root;
- my $current_parents = $fcache{$root} ||= _fetcher($root, $parent_fetcher);
+ my $current_parents = [ $root->$parent_fetcher ];
my $recurse_mergeout = [];
my $i = 0;
if($i < @$current_parents) {
my $new_root = $current_parents->[$i++];
+ unless ($pfetcher_is_coderef or $new_root->can($parent_fetcher)) {
+ confess "Could not find method $parent_fetcher in $new_root";
+ }
+
push(@STACK, [
$current_root,
$current_parents,
]);
$current_root = $new_root;
- $current_parents = $fcache{$current_root}
- ||= _fetcher($current_root, $parent_fetcher);
+ $current_parents = $fcache{$current_root} ||= [ $current_root->$parent_fetcher ];
$recurse_mergeout = [];
$i = 0;
next;
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More tests => 5;
BEGIN {
use_ok('Algorithm::C3');
package My::G;
our @ISA = ('My::E');
package My::H;
- our @ISA = ('My::G', 'My::F');
+ our @ISA = ('My::G', 'My::F');
+ sub method_exists_only_in_H { @ISA }
}
{
};
ok($@, '... this died as we expected');
-
+eval {
+ Algorithm::C3::merge(
+ 'My::H',
+ 'method_exists_only_in_H'
+ );
+};
+ok($@, '... this died as we expected');