add persistent merge cacheing parameter, VERSION/Changes for 0.05

diff --git a/Changes b/Changes
index 15e3b03..7d4a257 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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<SEE ALSO> section.
 
 =over 4
 
-=item B<merge ($root, $func_to_fetch_parent)>
+=item B<merge ($root, $func_to_fetch_parent, $cache)>
 
 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<merge> 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 (file)
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 (file)
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');
+