From: Brandon L Black Date: Wed, 23 Aug 2006 14:56:15 +0000 (+0000) Subject: add persistent merge cacheing parameter, VERSION/Changes for 0.05 X-Git-Tag: 0.05~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ca604ce2c96403a30175a3f20050445470647113;p=gitmo%2FAlgorithm-C3.git add persistent merge cacheing parameter, VERSION/Changes for 0.05 --- diff --git a/Changes b/Changes index 15e3b03..7d4a257 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension Algorithm-C3. +0.05 Not Yet Released XXXXXX + - Add the ability for the caller to supply a persistent + merge cache hashref + 0.04 Wed. Aug. 09, 2006 - Remove accidental "use Class::C3" from t/006_complex_merge.t (no functional changes from 0.03) diff --git a/MANIFEST b/MANIFEST index 6fd8e77..86e0994 100644 --- a/MANIFEST +++ b/MANIFEST @@ -12,5 +12,7 @@ t/003_merge.t t/004_merge.t t/005_order_disagreement.t t/006_complex_merge.t +t/007_cached_merge.t +t/008_cached_merge_unordered.t t/pod.t t/pod_coverage.t diff --git a/lib/Algorithm/C3.pm b/lib/Algorithm/C3.pm index 52cb318..be88dc5 100644 --- a/lib/Algorithm/C3.pm +++ b/lib/Algorithm/C3.pm @@ -6,14 +6,13 @@ use warnings; use Carp 'confess'; -our $VERSION = '0.04'; +our $VERSION = '0.05'; sub merge { - my ($root, $parent_fetcher) = @_; + my ($root, $parent_fetcher, $cache) = @_; + $cache ||= {}; my @STACK; # stack for simulating recursion - my %fcache; # cache of _fetcher results - my %mcache; # cache of merge do-block results my $pfetcher_is_coderef = ref($parent_fetcher) eq 'CODE'; @@ -42,13 +41,13 @@ sub merge { ]); $current_root = $new_root; - $current_parents = $fcache{$current_root} ||= [ $current_root->$parent_fetcher ]; + $current_parents = $cache->{pfetch}->{$current_root} ||= [ $current_root->$parent_fetcher ]; $recurse_mergeout = []; $i = 0; next; } - my $mergeout = $mcache{$current_root} ||= do { + my $mergeout = $cache->{merge}->{$current_root} ||= do { # This do-block is the code formerly known as the function # that was a perl-port of the python code at @@ -183,7 +182,7 @@ explaination, see the links in the L section. =over 4 -=item B +=item B This takes a C<$root> node, which can be anything really it is up to you. Then it takes a C<$func_to_fetch_parent> which @@ -214,6 +213,26 @@ The purpose of C<$func_to_fetch_parent> is to provide a way for C to extract the parents of C<$root>. This is needed for C3 to be able to do it's work. +The C<$cache> parameter is an entirely optional performance +measure, and should not change behavior. + +If supplied, it should be a hashref that merge can use as a +private cache between runs to speed things up. Generally +speaking, if you will be calling merge many times on related +things, and the parent fetching function will return constant +results given the same arguments during all of these calls, +you can and should reuse the same shared cache hash for all +of the calls. Example: + + sub do_some_merging { + my %merge_cache; + my @foo_mro = Algorithm::C3::Merge('Foo', \&get_supers, \%merge_cache); + my @bar_mro = Algorithm::C3::Merge('Bar', \&get_supers, \%merge_cache); + my @baz_mro = Algorithm::C3::Merge('Baz', \&get_supers, \%merge_cache); + my @quux_mro = Algorithm::C3::Merge('Quux', \&get_supers, \%merge_cache); + # ... + } + =back =head1 CODE COVERAGE diff --git a/t/007_cached_merge.t b/t/007_cached_merge.t new file mode 100644 index 0000000..7fbda51 --- /dev/null +++ b/t/007_cached_merge.t @@ -0,0 +1,153 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 12; + +BEGIN { + use_ok('Algorithm::C3'); +} + +=pod + +Just like 006_complex_merge, but with the caching turned on. + +This example is taken from: http://rt.cpan.org/Public/Bug/Display.html?id=20879 + + --- --- --- +Level 5 8 | A | 9 | B | A | C | (More General) + --- --- --- V + \ | / | + \ | / | + \ | / | + \ | / | + --- | +Level 4 7 | D | | + --- | + / \ | + / \ | + --- --- | +Level 3 4 | G | 6 | E | | + --- --- | + | | | + | | | + --- --- | +Level 2 3 | H | 5 | F | | + --- --- | + \ / | | + \ / | | + \ | | + / \ | | + / \ | | + --- --- | +Level 1 1 | J | 2 | I | | + --- --- | + \ / | + \ / | + --- v +Level 0 0 | K | (More Specialized) + --- + + +0123456789A +KJIHGFEDABC + +=cut + +{ + package Test::A; + sub x { 1 } + + package Test::B; + sub x { 1 } + + package Test::C; + sub x { 1 } + + package Test::D; + use base qw/Test::A Test::B Test::C/; + + package Test::E; + use base qw/Test::D/; + + package Test::F; + use base qw/Test::E/; + + package Test::G; + use base qw/Test::D/; + + package Test::H; + use base qw/Test::G/; + + package Test::I; + use base qw/Test::H Test::F/; + + package Test::J; + use base qw/Test::F/; + + package Test::K; + use base qw/Test::J Test::I/; +} + +sub supers { + no strict 'refs'; + @{$_[0] . '::ISA'}; +} + +my %cache; + +is_deeply( + [ Algorithm::C3::merge('Test::A', \&supers, \%cache) ], + [ qw(Test::A) ], + '... got the right C3 merge order for Test::A'); + +is_deeply( + [ Algorithm::C3::merge('Test::B', \&supers, \%cache) ], + [ qw(Test::B) ], + '... got the right C3 merge order for Test::B'); + +is_deeply( + [ Algorithm::C3::merge('Test::C', \&supers, \%cache) ], + [ qw(Test::C) ], + '... got the right C3 merge order for Test::C'); + +is_deeply( + [ Algorithm::C3::merge('Test::D', \&supers, \%cache) ], + [ qw(Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::D'); + +is_deeply( + [ Algorithm::C3::merge('Test::E', \&supers, \%cache) ], + [ qw(Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::E'); + +is_deeply( + [ Algorithm::C3::merge('Test::F', \&supers, \%cache) ], + [ qw(Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::F'); + +is_deeply( + [ Algorithm::C3::merge('Test::G', \&supers, \%cache) ], + [ qw(Test::G Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::G'); + +is_deeply( + [ Algorithm::C3::merge('Test::H', \&supers, \%cache) ], + [ qw(Test::H Test::G Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::H'); + +is_deeply( + [ Algorithm::C3::merge('Test::I', \&supers, \%cache) ], + [ qw(Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::I'); + +is_deeply( + [ Algorithm::C3::merge('Test::J', \&supers, \%cache) ], + [ qw(Test::J Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::J'); + +is_deeply( + [ Algorithm::C3::merge('Test::K', \&supers, \%cache) ], + [ qw(Test::K Test::J Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::K'); diff --git a/t/008_cached_merge_unordered.t b/t/008_cached_merge_unordered.t new file mode 100644 index 0000000..dfb49e1 --- /dev/null +++ b/t/008_cached_merge_unordered.t @@ -0,0 +1,155 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 12; + +BEGIN { + use_ok('Algorithm::C3'); +} + +=pod + +Just like 007_cached_merge, but test the MROs in some wierd order, rather +than alphabetical order. + +This example is taken from: http://rt.cpan.org/Public/Bug/Display.html?id=20879 + + --- --- --- +Level 5 8 | A | 9 | B | A | C | (More General) + --- --- --- V + \ | / | + \ | / | + \ | / | + \ | / | + --- | +Level 4 7 | D | | + --- | + / \ | + / \ | + --- --- | +Level 3 4 | G | 6 | E | | + --- --- | + | | | + | | | + --- --- | +Level 2 3 | H | 5 | F | | + --- --- | + \ / | | + \ / | | + \ | | + / \ | | + / \ | | + --- --- | +Level 1 1 | J | 2 | I | | + --- --- | + \ / | + \ / | + --- v +Level 0 0 | K | (More Specialized) + --- + + +0123456789A +KJIHGFEDABC + +=cut + +{ + package Test::A; + sub x { 1 } + + package Test::B; + sub x { 1 } + + package Test::C; + sub x { 1 } + + package Test::D; + use base qw/Test::A Test::B Test::C/; + + package Test::E; + use base qw/Test::D/; + + package Test::F; + use base qw/Test::E/; + + package Test::G; + use base qw/Test::D/; + + package Test::H; + use base qw/Test::G/; + + package Test::I; + use base qw/Test::H Test::F/; + + package Test::J; + use base qw/Test::F/; + + package Test::K; + use base qw/Test::J Test::I/; +} + +sub supers { + no strict 'refs'; + @{$_[0] . '::ISA'}; +} + +my %cache; + +is_deeply( + [ Algorithm::C3::merge('Test::J', \&supers, \%cache) ], + [ qw(Test::J Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::J'); + +is_deeply( + [ Algorithm::C3::merge('Test::G', \&supers, \%cache) ], + [ qw(Test::G Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::G'); + +is_deeply( + [ Algorithm::C3::merge('Test::B', \&supers, \%cache) ], + [ qw(Test::B) ], + '... got the right C3 merge order for Test::B'); + +is_deeply( + [ Algorithm::C3::merge('Test::D', \&supers, \%cache) ], + [ qw(Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::D'); + +is_deeply( + [ Algorithm::C3::merge('Test::C', \&supers, \%cache) ], + [ qw(Test::C) ], + '... got the right C3 merge order for Test::C'); + +is_deeply( + [ Algorithm::C3::merge('Test::I', \&supers, \%cache) ], + [ qw(Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::I'); + +is_deeply( + [ Algorithm::C3::merge('Test::K', \&supers, \%cache) ], + [ qw(Test::K Test::J Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::K'); + +is_deeply( + [ Algorithm::C3::merge('Test::E', \&supers, \%cache) ], + [ qw(Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::E'); + +is_deeply( + [ Algorithm::C3::merge('Test::F', \&supers, \%cache) ], + [ qw(Test::F Test::E Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::F'); + +is_deeply( + [ Algorithm::C3::merge('Test::A', \&supers, \%cache) ], + [ qw(Test::A) ], + '... got the right C3 merge order for Test::A'); + +is_deeply( + [ Algorithm::C3::merge('Test::H', \&supers, \%cache) ], + [ qw(Test::H Test::G Test::D Test::A Test::B Test::C) ], + '... got the right C3 merge order for Test::H'); +