Algorithm-C3-0.10/000755 000765 000024 00000000000 12373521707 014113 5ustar00gknopstaff000000 000000 Algorithm-C3-0.10/Changes000644 000765 000024 00000002217 12373521662 015410 0ustar00gknopstaff000000 000000 Revision history for Perl extension Algorithm-C3. 0.10 - 2014-08-15 - declare minimum version of perl as 5.6 in metadata 0.09 - 2014-03-01 - convert to use ExtUtils::MakeMaker using distar - include repo and bugtracker metadata 0.08 Thu. May 28, 2009 - Fix a couple of doc typos. - Don't create a fake Makefile.PL. 0.07 Mon. May 14, 2007 - Some very small optimizations had been gathering in the repo for a while, this gets them out to CPAN. Probably won't notice much difference except in extreme cases. 0.06 Fri. Nov. 17, 2006 - Added tests from konobi - Added some other new tests too - Fixed infinite loop on recursive heirarchies 0.05 Fri. Aug. 25, 2006 - 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) 0.03 Tue. Aug. 08, 2006 - New test + bugfix for RT#20879 0.02 Sun. Jul. 30, 2006 - code refactored for speed by Brandon L. Black 0.01 Wed. Feb. 15, 2006 - initial release, code and tests taken from Class::C3 Algorithm-C3-0.10/lib/000755 000765 000024 00000000000 12373521707 014661 5ustar00gknopstaff000000 000000 Algorithm-C3-0.10/maint/000755 000765 000024 00000000000 12373521707 015223 5ustar00gknopstaff000000 000000 Algorithm-C3-0.10/Makefile.PL000644 000765 000024 00000002335 12367634556 016102 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use 5.006; use ExtUtils::MakeMaker; (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; my %BUILD_DEPS = ( 'Test::More' => 0.47, ); # have to do this since old EUMM dev releases miss the eval $VERSION line my $mymeta = eval($ExtUtils::MakeMaker::VERSION) >= 6.57_02; my $mymeta_works = eval($ExtUtils::MakeMaker::VERSION) >= 6.57_07; WriteMakefile( NAME => 'Algorithm::C3', VERSION_FROM => 'lib/Algorithm/C3.pm', PREREQ_PM => { 'Carp' => 0.01, ($mymeta_works ? () : (%BUILD_DEPS)), }, MIN_PERL_VERSION => 5.006, $mymeta_works ? (BUILD_REQUIRES => \%BUILD_DEPS) : (), ($mymeta && !$mymeta_works ? (NO_MYMETA => 1) : ()), -f 'META.yml' ? () : (META_MERGE => { 'meta-spec' => { version => 2 }, resources => { # r/w: gitmo@git.shadowcat.co.uk:Algorithm-C3.git repository => { url => 'git://git.shadowcat.co.uk/gitmo/Algorithm-C3.git', web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Algorithm-C3.git', type => 'git', }, bugtracker => { mailto => 'bug-Algorithm-C3@rt.cpan.org', web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Algorithm-C3', }, }, }), ); Algorithm-C3-0.10/MANIFEST000644 000765 000024 00000001135 12373521707 015244 0ustar00gknopstaff000000 000000 Changes lib/Algorithm/C3.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/000_load.t t/001_merge.t t/002_merge.t 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/009_dbic_merge.t t/010_complex_merge_classless.t t/011_infinite_loop.t xt/pod.t xt/pod_coverage.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Algorithm-C3-0.10/META.json000644 000765 000024 00000002546 12373521707 015543 0ustar00gknopstaff000000 000000 { "abstract" : "A module for merging hierarchies using the C3 algorithm", "author" : [ "Stevan Little ", "Brandon L. Black " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Algorithm-C3", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0.47" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0.01", "perl" : "5.006" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Algorithm-C3@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Algorithm-C3" }, "repository" : { "type" : "git", "url" : "git://git.shadowcat.co.uk/gitmo/Algorithm-C3.git", "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Algorithm-C3.git" } }, "version" : "0.10" } Algorithm-C3-0.10/META.yml000644 000765 000024 00000001335 12373521707 015366 0ustar00gknopstaff000000 000000 --- abstract: 'A module for merging hierarchies using the C3 algorithm' author: - 'Stevan Little ' - 'Brandon L. Black ' build_requires: Test::More: '0.47' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Algorithm-C3 no_index: directory: - t - inc requires: Carp: '0.01' perl: '5.006' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Algorithm-C3 repository: git://git.shadowcat.co.uk/gitmo/Algorithm-C3.git version: '0.10' Algorithm-C3-0.10/README000644 000765 000024 00000013402 12373521707 014773 0ustar00gknopstaff000000 000000 NAME Algorithm::C3 - A module for merging hierarchies using the C3 algorithm SYNOPSIS use Algorithm::C3; # merging a classic diamond # inheritance graph like this: # # # / \ # # \ / # my @merged = Algorithm::C3::merge( 'D', sub { # extract the ISA array # from the package no strict 'refs'; @{$_[0] . '::ISA'}; } ); print join ", " => @merged; # prints D, B, C, A DESCRIPTION This module implements the C3 algorithm. I have broken this out into it's own module because I found myself copying and pasting it way too often for various needs. Most of the uses I have for C3 revolve around class building and metamodels, but it could also be used for things like dependency resolution as well since it tends to do such a nice job of preserving local precedence orderings. Below is a brief explanation of C3 taken from the Class::C3 module. For more detailed information, see the "SEE ALSO" section and the links there. What is C3? C3 is the name of an algorithm which aims to provide a sane method resolution order under multiple inheritance. It was first introduced in the language Dylan (see links in the "SEE ALSO" section), and then later adopted as the preferred MRO (Method Resolution Order) for the new-style classes in Python 2.3. Most recently it has been adopted as the 'canonical' MRO for Perl 6 classes, and the default MRO for Parrot objects as well. How does C3 work. C3 works by always preserving local precedence ordering. This essentially means that no class will appear before any of it's subclasses. Take the classic diamond inheritance pattern for instance: / \ \ / The standard Perl 5 MRO would be (D, B, A, C). The result being that A appears before C, even though C is the subclass of A. The C3 MRO algorithm however, produces the following MRO (D, B, C, A), which does not have this same issue. This example is fairly trivial, for more complex examples and a deeper explanation, see the links in the "SEE ALSO" section. FUNCTION merge ($root, $func_to_fetch_parent, $cache) This takes a $root node, which can be anything really it is up to you. Then it takes a $func_to_fetch_parent which can be either a CODE reference (see SYNOPSIS above for an example), or a string containing a method name to be called on all the items being linearized. An example of how this might look is below: { package A; sub supers { no strict 'refs'; @{$_[0] . '::ISA'}; } package C; our @ISA = ('A'); package B; our @ISA = ('A'); package D; our @ISA = ('B', 'C'); } print join ", " => Algorithm::C3::merge('D', 'supers'); The purpose of $func_to_fetch_parent is to provide a way for "merge" to extract the parents of $root. This is needed for C3 to be able to do it's work. The $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); # ... } CODE COVERAGE I use Devel::Cover to test the code coverage of my tests, below is the Devel::Cover report on this module's test suite. ------------------------ ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ------------------------ ------ ------ ------ ------ ------ ------ ------ Algorithm/C3.pm 100.0 100.0 100.0 100.0 100.0 100.0 100.0 ------------------------ ------ ------ ------ ------ ------ ------ ------ Total 100.0 100.0 100.0 100.0 100.0 100.0 100.0 ------------------------ ------ ------ ------ ------ ------ ------ ------ SEE ALSO The original Dylan paper The prototype Perl 6 Object Model uses C3 Parrot now uses C3 Python 2.3 MRO related links C3 for TinyCLOS AUTHORS Stevan Little, Brandon L. Black, COPYRIGHT AND LICENSE Copyright 2006 by Infinity Interactive, Inc. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Algorithm-C3-0.10/t/000755 000765 000024 00000000000 12373521707 014356 5ustar00gknopstaff000000 000000 Algorithm-C3-0.10/xt/000755 000765 000024 00000000000 12373521707 014546 5ustar00gknopstaff000000 000000 Algorithm-C3-0.10/xt/pod.t000644 000765 000024 00000000257 12331162675 015520 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Algorithm-C3-0.10/xt/pod_coverage.t000644 000765 000024 00000000317 12304463305 017362 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Algorithm-C3-0.10/t/000_load.t000644 000765 000024 00000000170 12304333515 016027 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; BEGIN { use_ok('Algorithm::C3'); }Algorithm-C3-0.10/t/001_merge.t000644 000765 000024 00000002522 12304333515 016213 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 5; BEGIN { use_ok('Algorithm::C3'); } { package My::A; package My::C; our @ISA = ('My::A'); package My::B; our @ISA = ('My::A'); package My::D; our @ISA = ('My::B', 'My::C'); } { my @merged = Algorithm::C3::merge( 'My::D', sub { no strict 'refs'; @{$_[0] . '::ISA'}; } ); is_deeply( \@merged, [ qw/My::D My::B My::C My::A/ ], '... merged the lists correctly'); } { package My::E; sub supers { no strict 'refs'; @{$_[0] . '::ISA'}; } package My::F; our @ISA = ('My::E'); package My::G; our @ISA = ('My::E'); package My::H; our @ISA = ('My::G', 'My::F'); sub method_exists_only_in_H { @ISA } } { my @merged = Algorithm::C3::merge('My::H', 'supers'); is_deeply( \@merged, [ qw/My::H My::G My::F My::E/ ], '... merged the lists correctly'); } eval { Algorithm::C3::merge( 'My::H', 'this_method_does_not_exist' ); }; ok($@, '... this died as we expected'); eval { Algorithm::C3::merge( 'My::H', 'method_exists_only_in_H' ); }; ok($@, '... this died as we expected'); Algorithm-C3-0.10/t/002_merge.t000644 000765 000024 00000005442 12304333515 016220 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 7; BEGIN { use_ok('Algorithm::C3'); } =pod This example is take from: http://www.python.org/2.3/mro.html "My first example" class O: pass class F(O): pass class E(O): pass class D(O): pass class C(D,F): pass class B(D,E): pass class A(B,C): pass 6 --- Level 3 | O | (more general) / --- \ / | \ | / | \ | / | \ | --- --- --- | Level 2 3 | D | 4| E | | F | 5 | --- --- --- | \ \ _ / | | \ / \ _ | | \ / \ | | --- --- | Level 1 1 | B | | C | 2 | --- --- | \ / | \ / \ / --- Level 0 0 | A | (more specialized) --- =cut { package Test::O; sub supers { no strict 'refs'; @{$_[0] . '::ISA'}; } package Test::F; use base 'Test::O'; package Test::E; use base 'Test::O'; package Test::D; use base 'Test::O'; package Test::C; use base ('Test::D', 'Test::F'); package Test::B; use base ('Test::D', 'Test::E'); package Test::A; use base ('Test::B', 'Test::C'); } is_deeply( [ Algorithm::C3::merge('Test::F', 'supers') ], [ qw(Test::F Test::O) ], '... got the right C3 merge order for Test::F'); is_deeply( [ Algorithm::C3::merge('Test::E', 'supers') ], [ qw(Test::E Test::O) ], '... got the right C3 merge order for Test::E'); is_deeply( [ Algorithm::C3::merge('Test::D', 'supers') ], [ qw(Test::D Test::O) ], '... got the right C3 merge order for Test::D'); is_deeply( [ Algorithm::C3::merge('Test::C', 'supers') ], [ qw(Test::C Test::D Test::F Test::O) ], '... got the right C3 merge order for Test::C'); is_deeply( [ Algorithm::C3::merge('Test::B', 'supers') ], [ qw(Test::B Test::D Test::E Test::O) ], '... got the right C3 merge order for Test::B'); is_deeply( [ Algorithm::C3::merge('Test::A', 'supers') ], [ qw(Test::A Test::B Test::C Test::D Test::E Test::F Test::O) ], '... got the right C3 merge order for Test::A'); Algorithm-C3-0.10/t/003_merge.t000644 000765 000024 00000003500 12304333515 016212 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; BEGIN { use_ok('Algorithm::C3'); } =pod This example is take from: http://www.python.org/2.3/mro.html "My second example" class O: pass class F(O): pass class E(O): pass class D(O): pass class C(D,F): pass class B(E,D): pass class A(B,C): pass 6 --- Level 3 | O | / --- \ / | \ / | \ / | \ --- --- --- Level 2 2 | E | 4 | D | | F | 5 --- --- --- \ / \ / \ / \ / \ / \ / --- --- Level 1 1 | B | | C | 3 --- --- \ / \ / --- Level 0 0 | A | --- >>> A.mro() (, , , , , , ) =cut { package Test::O; sub supers { no strict 'refs'; @{$_[0] . '::ISA'}; } package Test::F; use base 'Test::O'; package Test::E; use base 'Test::O'; package Test::D; use base 'Test::O'; package Test::C; use base ('Test::D', 'Test::F'); package Test::B; use base ('Test::E', 'Test::D'); package Test::A; use base ('Test::B', 'Test::C'); } is_deeply( [ Algorithm::C3::merge('Test::A', 'supers') ], [ qw(Test::A Test::B Test::E Test::C Test::D Test::F Test::O) ], '... got the right C3 merge order for Test::A'); Algorithm-C3-0.10/t/004_merge.t000644 000765 000024 00000002470 12304333515 016220 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; BEGIN { use_ok('Algorithm::C3'); } =pod example taken from: L Object ^ | LifeForm ^ ^ / \ Sentient BiPedal ^ ^ | | Intelligent Humanoid ^ ^ \ / Vulcan define class () end class; define class () end class; define class () end class; define class () end class; define class (, ) end class; =cut { package Object; sub my_ISA { no strict 'refs'; @{$_[0] . '::ISA'}; } package LifeForm; use base 'Object'; package Sentient; use base 'LifeForm'; package BiPedal; use base 'LifeForm'; package Intelligent; use base 'Sentient'; package Humanoid; use base 'BiPedal'; package Vulcan; use base ('Intelligent', 'Humanoid'); } is_deeply( [ Algorithm::C3::merge('Vulcan', 'my_ISA') ], [ qw(Vulcan Intelligent Sentient Humanoid BiPedal LifeForm Object) ], '... got the right C3 merge order for the Vulcan Dylan Example');Algorithm-C3-0.10/t/005_order_disagreement.t000644 000765 000024 00000001477 12304333515 020772 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; BEGIN { use_ok('Algorithm::C3'); } =pod This example is take from: http://www.python.org/2.3/mro.html "Serious order disagreement" # From Guido class O: pass class X(O): pass class Y(O): pass class A(X,Y): pass class B(Y,X): pass try: class Z(A,B): pass #creates Z(A,B) in Python 2.2 except TypeError: pass # Z(A,B) cannot be created in Python 2.3 =cut { package X; package Y; package XY; our @ISA = ('X', 'Y'); package YX; our @ISA = ('Y', 'X'); package Z; our @ISA = ('XY', 'YX'); } eval { Algorithm::C3::merge('Z' => sub { no strict 'refs'; @{$_[0] . '::ISA'}; }) }; like($@, qr/^Inconsistent hierarchy/, '... got the right error with an inconsistent hierarchy'); Algorithm-C3-0.10/t/006_complex_merge.t000644 000765 000024 00000010024 12304333515 017743 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 12; BEGIN { use_ok('Algorithm::C3'); } =pod 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'}; } is_deeply( [ Algorithm::C3::merge('Test::A', \&supers) ], [ qw(Test::A) ], '... got the right C3 merge order for Test::A'); is_deeply( [ Algorithm::C3::merge('Test::B', \&supers) ], [ qw(Test::B) ], '... got the right C3 merge order for Test::B'); is_deeply( [ Algorithm::C3::merge('Test::C', \&supers) ], [ qw(Test::C) ], '... got the right C3 merge order for Test::C'); is_deeply( [ Algorithm::C3::merge('Test::D', \&supers) ], [ 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) ], [ 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) ], [ 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) ], [ 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) ], [ 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) ], [ 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) ], [ 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) ], [ 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'); Algorithm-C3-0.10/t/007_cached_merge.t000644 000765 000024 00000010301 12304333515 017502 0ustar00gknopstaff000000 000000 #!/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'); Algorithm-C3-0.10/t/008_cached_merge_unordered.t000644 000765 000024 00000010350 12304333515 021556 0ustar00gknopstaff000000 000000 #!/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'); Algorithm-C3-0.10/t/009_dbic_merge.t000644 000765 000024 00000007555 12304333515 017217 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 2; BEGIN { use_ok('Algorithm::C3'); } =pod This example is taken from the inheritance graph of DBIx::Class::Core in DBIx::Class v0.07002: (No ASCII art this time, this graph is insane) The xx:: prefixes are just to be sure these bogus declarations never stomp on real ones =cut { package xx::DBIx::Class::Core; our @ISA = qw/ xx::DBIx::Class::Serialize::Storable xx::DBIx::Class::InflateColumn xx::DBIx::Class::Relationship xx::DBIx::Class::PK::Auto xx::DBIx::Class::PK xx::DBIx::Class::Row xx::DBIx::Class::ResultSourceProxy::Table xx::DBIx::Class::AccessorGroup /; package xx::DBIx::Class::InflateColumn; our @ISA = qw/ xx::DBIx::Class::Row /; package xx::DBIx::Class::Row; our @ISA = qw/ xx::DBIx::Class /; package xx::DBIx::Class; our @ISA = qw/ xx::DBIx::Class::Componentised xx::Class::Data::Accessor /; package xx::DBIx::Class::Relationship; our @ISA = qw/ xx::DBIx::Class::Relationship::Helpers xx::DBIx::Class::Relationship::Accessor xx::DBIx::Class::Relationship::CascadeActions xx::DBIx::Class::Relationship::ProxyMethods xx::DBIx::Class::Relationship::Base xx::DBIx::Class /; package xx::DBIx::Class::Relationship::Helpers; our @ISA = qw/ xx::DBIx::Class::Relationship::HasMany xx::DBIx::Class::Relationship::HasOne xx::DBIx::Class::Relationship::BelongsTo xx::DBIx::Class::Relationship::ManyToMany /; package xx::DBIx::Class::Relationship::ProxyMethods; our @ISA = qw/ xx::DBIx::Class /; package xx::DBIx::Class::Relationship::Base; our @ISA = qw/ xx::DBIx::Class /; package xx::DBIx::Class::PK::Auto; our @ISA = qw/ xx::DBIx::Class /; package xx::DBIx::Class::PK; our @ISA = qw/ xx::DBIx::Class::Row /; package xx::DBIx::Class::ResultSourceProxy::Table; our @ISA = qw/ xx::DBIx::Class::AccessorGroup xx::DBIx::Class::ResultSourceProxy /; package xx::DBIx::Class::ResultSourceProxy; our @ISA = qw/ xx::DBIx::Class /; package xx::Class::Data::Accessor; our @ISA = (); package xx::DBIx::Class::Relationship::HasMany; our @ISA = (); package xx::DBIx::Class::Relationship::HasOne; our @ISA = (); package xx::DBIx::Class::Relationship::BelongsTo; our @ISA = (); package xx::DBIx::Class::Relationship::ManyToMany; our @ISA = (); package xx::DBIx::Class::Componentised; our @ISA = (); package xx::DBIx::Class::AccessorGroup; our @ISA = (); package xx::DBIx::Class::Serialize::Storable; our @ISA = (); package xx::DBIx::Class::Relationship::Accessor; our @ISA = (); package xx::DBIx::Class::Relationship::CascadeActions; our @ISA = (); } sub supers { no strict 'refs'; @{$_[0] . '::ISA'}; } is_deeply( [ Algorithm::C3::merge('xx::DBIx::Class::Core', \&supers) ], [qw/ xx::DBIx::Class::Core xx::DBIx::Class::Serialize::Storable xx::DBIx::Class::InflateColumn xx::DBIx::Class::Relationship xx::DBIx::Class::Relationship::Helpers xx::DBIx::Class::Relationship::HasMany xx::DBIx::Class::Relationship::HasOne xx::DBIx::Class::Relationship::BelongsTo xx::DBIx::Class::Relationship::ManyToMany xx::DBIx::Class::Relationship::Accessor xx::DBIx::Class::Relationship::CascadeActions xx::DBIx::Class::Relationship::ProxyMethods xx::DBIx::Class::Relationship::Base xx::DBIx::Class::PK::Auto xx::DBIx::Class::PK xx::DBIx::Class::Row xx::DBIx::Class::ResultSourceProxy::Table xx::DBIx::Class::AccessorGroup xx::DBIx::Class::ResultSourceProxy xx::DBIx::Class xx::DBIx::Class::Componentised xx::Class::Data::Accessor /], '... got the right C3 merge order for DBIx::Class::Core'); Algorithm-C3-0.10/t/010_complex_merge_classless.t000644 000765 000024 00000006324 12304333515 022022 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More tests => 12; BEGIN { use_ok('Algorithm::C3'); } =pod 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 my $foo = { k => [qw(j i)], j => [qw(f)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a b c)], c => [], b => [], a => [], }; sub supers { return @{ $foo->{ $_[0] } }; } is_deeply( [ Algorithm::C3::merge('a', \&supers) ], [ qw(a) ], '... got the right C3 merge order for a'); is_deeply( [ Algorithm::C3::merge('b', \&supers) ], [ qw(b) ], '... got the right C3 merge order for b'); is_deeply( [ Algorithm::C3::merge('c', \&supers) ], [ qw(c) ], '... got the right C3 merge order for c'); is_deeply( [ Algorithm::C3::merge('d', \&supers) ], [ qw(d a b c) ], '... got the right C3 merge order for d'); is_deeply( [ Algorithm::C3::merge('e', \&supers) ], [ qw(e d a b c) ], '... got the right C3 merge order for e'); is_deeply( [ Algorithm::C3::merge('f', \&supers) ], [ qw(f e d a b c) ], '... got the right C3 merge order for f'); is_deeply( [ Algorithm::C3::merge('g', \&supers) ], [ qw(g d a b c) ], '... got the right C3 merge order for g'); is_deeply( [ Algorithm::C3::merge('h', \&supers) ], [ qw(h g d a b c) ], '... got the right C3 merge order for h'); is_deeply( [ Algorithm::C3::merge('i', \&supers) ], [ qw(i h g f e d a b c) ], '... got the right C3 merge order for i'); is_deeply( [ Algorithm::C3::merge('j', \&supers) ], [ qw(j f e d a b c) ], '... got the right C3 merge order for j'); is_deeply( [ Algorithm::C3::merge('k', \&supers) ], [ qw(k j i h g f e d a b c) ], '... got the right C3 merge order for k'); Algorithm-C3-0.10/t/011_infinite_loop.t000644 000765 000024 00000005753 12304333515 017764 0ustar00gknopstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::More; use Algorithm::C3; # we already did use_ok 10 times by now.. plan skip_all => "Your system has no SIGALRM" if !exists $SIG{ALRM}; plan tests => 8; =pod These are like the 010_complex_merge_classless test, but an infinite loop has been made in the heirarchy, to test that we can fail cleanly instead of going into an infinite loop =cut my @loopies = ( { #1 k => [qw(j i)], j => [qw(f)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(f)], d => [qw(a b c)], c => [], b => [], a => [], }, { #2 k => [qw(j i)], j => [qw(f)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a b c)], c => [qw(f)], b => [], a => [], }, { #3 k => [qw(j i)], j => [qw(f)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a b c)], c => [], b => [], a => [qw(k)], }, { #4 k => [qw(j i)], j => [qw(f k)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a b c)], c => [], b => [], a => [], }, { #5 k => [qw(j i)], j => [qw(f)], i => [qw(h f)], h => [qw(k g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a b c)], c => [], b => [], a => [], }, { #6 k => [qw(j i)], j => [qw(f)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a b c)], c => [], b => [qw(b)], a => [], }, { #7 k => [qw(k j i)], j => [qw(f)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a b c)], c => [], b => [], a => [], }, { #7 k => [qw(j i)], j => [qw(f)], i => [qw(h f)], h => [qw(g)], g => [qw(d)], f => [qw(e)], e => [qw(d)], d => [qw(a h b c)], c => [], b => [], a => [], }, ); foreach my $loopy (@loopies) { eval { local $SIG{ALRM} = sub { die "ALRMTimeout" }; alarm(3); Algorithm::C3::merge('k', sub { return @{ $loopy->{ $_[0] } }; }); }; if(my $err = $@) { if($err =~ /ALRMTimeout/) { ok(0, "Loop terminated by SIGALRM"); } elsif($err =~ /Infinite loop detected/) { ok(1, "Graceful exception thrown"); } else { ok(0, "Unrecognized exception: $err"); } } else { ok(0, "Infinite loop apparently succeeded???"); } } Algorithm-C3-0.10/maint/Makefile.PL.include000644 000765 000024 00000000405 12304463305 020607 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar; use ExtUtils::MakeMaker 6.68 (); author [ 'Stevan Little ', 'Brandon L. Black ', ]; 1; Algorithm-C3-0.10/lib/Algorithm/000755 000765 000024 00000000000 12373521707 016607 5ustar00gknopstaff000000 000000 Algorithm-C3-0.10/lib/Algorithm/C3.pm000644 000765 000024 00000023560 12373521636 017421 0ustar00gknopstaff000000 000000 package Algorithm::C3; use strict; use warnings; use Carp 'confess'; our $VERSION = '0.10'; sub merge { my ($root, $parent_fetcher, $cache) = @_; $cache ||= {}; my @STACK; # stack for simulating recursion 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 = [ $root->$parent_fetcher ]; my $recurse_mergeout = []; my $i = 0; my %seen = ( $root => 1 ); my ($new_root, $mergeout, %tails); while(1) { if($i < @$current_parents) { $new_root = $current_parents->[$i++]; if($seen{$new_root}) { my @isastack; my $reached; for(my $i = 0; $i < $#STACK; $i += 4) { if($reached || ($reached = ($STACK[$i] eq $new_root))) { push(@isastack, $STACK[$i]); } } my $isastack = join(q{ -> }, @isastack, $current_root, $new_root); die "Infinite loop detected in parents of '$root': $isastack"; } $seen{$new_root} = 1; 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, $recurse_mergeout, $i); $current_root = $new_root; $current_parents = $cache->{pfetch}->{$current_root} ||= [ $current_root->$parent_fetcher ]; $recurse_mergeout = []; $i = 0; next; } $seen{$current_root} = 0; $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 # http://www.python.org/2.3/mro.html :) # Initial set (make sure everything is copied - it will be modded) my @seqs = map { [@$_] } @$recurse_mergeout; push(@seqs, [@$current_parents]) if @$current_parents; # Construct the tail-checking hash (actually, it's cheaper and still # correct to re-use it throughout this function) foreach my $seq (@seqs) { $tails{$seq->[$_]}++ for (1..$#$seq); } my @res = ( $current_root ); while (1) { my $cand; my $winner; foreach (@seqs) { next if !@$_; if(!$winner) { # looking for a winner $cand = $_->[0]; # seq head is candidate next if $tails{$cand}; # he loses if in %tails # Handy warn to give a output like the ones on # http://www.python.org/download/releases/2.3/mro/ #warn " = " . join(' + ', @res) . " + merge([" . join('] [', map { join(', ', @$_) } grep { @$_ } @seqs) . "])\n"; push @res => $winner = $cand; shift @$_; # strip off our winner $tails{$_->[0]}-- if @$_; # keep %tails sane } elsif($_->[0] eq $winner) { shift @$_; # strip off our winner $tails{$_->[0]}-- if @$_; # keep %tails sane } } # Handy warn to give a output like the ones on # http://www.python.org/download/releases/2.3/mro/ #warn " = " . join(' + ', @res) . "\n" if !$cand; last if !$cand; die q{Inconsistent hierarchy found while merging '} . $current_root . qq{':\n\t} . qq{current merge results [\n\t\t} . (join ",\n\t\t" => @res) . qq{\n\t]\n\t} . qq{merging failed on '$cand'\n} if !$winner; } \@res; }; return @$mergeout if !@STACK; $i = pop(@STACK); $recurse_mergeout = pop(@STACK); $current_parents = pop(@STACK); $current_root = pop(@STACK); push(@$recurse_mergeout, $mergeout); } } 1; __END__ =pod =head1 NAME Algorithm::C3 - A module for merging hierarchies using the C3 algorithm =head1 SYNOPSIS use Algorithm::C3; # merging a classic diamond # inheritance graph like this: # # # / \ # # \ / # my @merged = Algorithm::C3::merge( 'D', sub { # extract the ISA array # from the package no strict 'refs'; @{$_[0] . '::ISA'}; } ); print join ", " => @merged; # prints D, B, C, A =head1 DESCRIPTION This module implements the C3 algorithm. I have broken this out into it's own module because I found myself copying and pasting it way too often for various needs. Most of the uses I have for C3 revolve around class building and metamodels, but it could also be used for things like dependency resolution as well since it tends to do such a nice job of preserving local precedence orderings. Below is a brief explanation of C3 taken from the L module. For more detailed information, see the L section and the links there. =head2 What is C3? C3 is the name of an algorithm which aims to provide a sane method resolution order under multiple inheritance. It was first introduced in the language Dylan (see links in the L section), and then later adopted as the preferred MRO (Method Resolution Order) for the new-style classes in Python 2.3. Most recently it has been adopted as the 'canonical' MRO for Perl 6 classes, and the default MRO for Parrot objects as well. =head2 How does C3 work. C3 works by always preserving local precedence ordering. This essentially means that no class will appear before any of it's subclasses. Take the classic diamond inheritance pattern for instance: / \ \ / The standard Perl 5 MRO would be (D, B, A, C). The result being that B appears before B, even though B is the subclass of B. The C3 MRO algorithm however, produces the following MRO (D, B, C, A), which does not have this same issue. This example is fairly trivial, for more complex examples and a deeper explanation, see the links in the L section. =head1 FUNCTION =over 4 =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 can be either a CODE reference (see L above for an example), or a string containing a method name to be called on all the items being linearized. An example of how this might look is below: { package A; sub supers { no strict 'refs'; @{$_[0] . '::ISA'}; } package C; our @ISA = ('A'); package B; our @ISA = ('A'); package D; our @ISA = ('B', 'C'); } print join ", " => Algorithm::C3::merge('D', 'supers'); 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 I use B to test the code coverage of my tests, below is the B report on this module's test suite. ------------------------ ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ------------------------ ------ ------ ------ ------ ------ ------ ------ Algorithm/C3.pm 100.0 100.0 100.0 100.0 100.0 100.0 100.0 ------------------------ ------ ------ ------ ------ ------ ------ ------ Total 100.0 100.0 100.0 100.0 100.0 100.0 100.0 ------------------------ ------ ------ ------ ------ ------ ------ ------ =head1 SEE ALSO =head2 The original Dylan paper =over 4 =item L =back =head2 The prototype Perl 6 Object Model uses C3 =over 4 =item L =back =head2 Parrot now uses C3 =over 4 =item L =item L =back =head2 Python 2.3 MRO related links =over 4 =item L =item L =back =head2 C3 for TinyCLOS =over 4 =item L =back =head1 AUTHORS Stevan Little, Estevan@iinteractive.comE Brandon L. Black, Eblblack@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright 2006 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut