From: Stevan Little Date: Wed, 15 Feb 2006 21:48:30 +0000 (+0000) Subject: version 0.11 X-Git-Tag: 0_11~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2ffffc6d4b76c053ddf254ef9356c92bba7d2acf;p=gitmo%2FClass-C3.git version 0.11 --- diff --git a/ChangeLog b/ChangeLog index bb7859a..f9a7655 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,13 @@ Revision history for Perl extension Class::C3. +0.11 + - added some more tests for edge cases + - removed INIT, you must explicitly call &initialize now + - added docs explaining this + - altered tests as needed + - moved the C3 algorithm to Algorithm::C3 and added + that as a dependency to this module + 0.10 - Wed, Feb 8, 2006 - removed the Sub::Name and NEXT dependencies and made the test just skip if they are not present diff --git a/Makefile.PL b/Makefile.PL index 5aac597..431d78c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -6,5 +6,6 @@ WriteMakefile( 'Test::More' => 0.47, 'Test::Exception' => 0.15, 'Scalar::Util' => 1.18, + 'Algorithm::C3' => 0.01, } ); diff --git a/README b/README index 1223031..5e61818 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Class::C3 version 0.10 +Class::C3 version 0.11 =========================== INSTALLATION diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm index 78b420f..7fb11bf 100644 --- a/lib/Class/C3.pm +++ b/lib/Class/C3.pm @@ -5,8 +5,9 @@ use strict; use warnings; use Scalar::Util 'blessed'; +use Algorithm::C3; -our $VERSION = '0.10'; +our $VERSION = '0.11'; # this is our global stash of both # MRO's and method dispatch tables @@ -41,16 +42,6 @@ sub import { ## initializers -# NOTE: -# this will not run under the following -# conditions: -# - mod_perl -# - require Class::C3; -# - eval "use Class::C3" -# in all those cases, you need to call -# the initialize() function manually -INIT { initialize() } - sub initialize { # why bother if we don't have anything ... return unless keys %MRO; @@ -147,56 +138,12 @@ sub _remove_method_dispatch_table { ## functions for calculating C3 MRO -# this function is a perl-port of the -# python code on this page: -# http://www.python.org/2.3/mro.html -sub _merge { - my (@seqs) = @_; - my $class_being_merged = $seqs[0]->[0]; - my @res; - while (1) { - # remove all empty seqences - my @nonemptyseqs = (map { (@{$_} ? $_ : ()) } @seqs); - # return the list if we have no more no-empty sequences - return @res if not @nonemptyseqs; - my $reject; - my $cand; # a canidate .. - foreach my $seq (@nonemptyseqs) { - $cand = $seq->[0]; # get the head of the list - my $nothead; - foreach my $sub_seq (@nonemptyseqs) { - # XXX - this is instead of the python "in" - my %in_tail = (map { $_ => 1 } @{$sub_seq}[ 1 .. $#{$sub_seq} ]); - # NOTE: - # jump out as soon as we find one matching - # there is no reason not too. However, if - # we find one, then just remove the '&& last' - ++$nothead && last if exists $in_tail{$cand}; - } - last unless $nothead; # leave the loop with our canidate ... - $reject = $cand; - $cand = undef; # otherwise, reject it ... - } - die "Inconsistent hierarchy found while merging '$class_being_merged':\n\t" . - "current merge results [\n\t\t" . (join ",\n\t\t" => @res) . "\n\t]\n\t" . - "mergeing failed on '$reject'\n" if not $cand; - push @res => $cand; - # now loop through our non-empties and pop - # off the head if it matches our canidate - foreach my $seq (@nonemptyseqs) { - shift @{$seq} if $seq->[0] eq $cand; - } - } -} - sub calculateMRO { my ($class) = @_; - no strict 'refs'; - return _merge( - [ $class ], # the class we are linearizing - (map { [ calculateMRO($_) ] } @{"${class}::ISA"}), # the MRO of all the superclasses - [ @{"${class}::ISA"} ] # a list of all the superclasses - ); + return Algorithm::C3::merge($class, sub { + no strict 'refs'; + @{$_[0] . '::ISA'}; + }); } package # hide me from PAUSE @@ -286,6 +233,10 @@ Class::C3 - A pragma to use the C3 method resolution order algortihm # package main; + + # initializez the C3 module + # (formerly called in INIT) + Class::C3::initialize(); print join ', ' => Class::C3::calculateMRO('Diamond_D') # prints D, B, C, A @@ -296,9 +247,8 @@ Class::C3 - A pragma to use the C3 method resolution order algortihm =head1 DESCRIPTION -This is currently an experimental pragma to change Perl 5's standard method resolution order -from depth-first left-to-right (a.k.a - pre-order) to the more sophisticated C3 method resolution -order. +This is pragma to change Perl 5's standard method resolution order from depth-first left-to-right +(a.k.a - pre-order) to the more sophisticated C3 method resolution order. =head2 What is C3? @@ -328,11 +278,11 @@ the L section. =head2 How does this module work? -This module uses a technique similar to Perl 5's method caching. During the INIT phase, this module -calculates the MRO of all the classes which called C. It then gathers information from -the symbol tables of each of those classes, and builds a set of method aliases for the correct -dispatch ordering. Once all these C3-based method tables are created, it then adds the method aliases -into the local classes symbol table. +This module uses a technique similar to Perl 5's method caching. When C is +called, this module calculates the MRO of all the classes which called C. It then +gathers information from the symbol tables of each of those classes, and builds a set of method +aliases for the correct dispatch ordering. Once all these C3-based method tables are created, it +then adds the method aliases into the local classes symbol table. The end result is actually classes with pre-cached method dispatch. However, this caching does not do well if you start changing your C<@ISA> or messing with class symbol tables, so you should consider @@ -364,8 +314,15 @@ Given a C<$class> this will return an array of class names in the proper C3 meth =item B -This can be used to initalize the C3 method dispatch tables. You need to call this if you are running -under mod_perl, or in any other environment which does not run the INIT phase of the perl compiler. +This B to initalize the C3 method dispatch tables, this module B if +you do not do this. It is advised to do this as soon as possible B any classes which use C3. + +This function used to be called automatically for you in the INIT phase of the perl compiler, but +that lead to warnings if this module was required at runtime. After discussion with my user base +(the L folks), we decided that calling this in INIT was more of an annoyance than a +convience. I apologize to anyone this causes problems for (although i would very suprised if I had +any other users other than the L folks). The simplest solution of course is to define +your own INIT method which calls this function. NOTE: This can B be used to re-load the dispatch tables for all classes. Use C for that. @@ -426,15 +383,15 @@ that you cannot dispatch to a method of a different name (this is how C The next thing to keep in mind is that you will need to pass all arguments to C it can not automatically use the current C<@_>. -=head1 CAVEATS +There are some caveats about using C, see below for those. -Let me first say, this is an experimental module, and so it should not be used for anything other -then other experimentation for the time being. +=head1 CAVEATS -That said, it is the authors intention to make this into a completely usable and production stable -module if possible. Time will tell. +This module used to be labeled as I, however it has now been pretty heavily tested by +the good folks over at L and I am confident this module is perfectly usable for +whatever your needs might be. -And now, onto the caveats. +But there are still caveats, so here goes ... =over 4 @@ -455,20 +412,32 @@ in F for more information. =item Adding/deleting methods from class symbol tables. -This module calculates the MRO for each requested class during the INIT phase by interogatting the symbol -tables of said classes. So any symbol table manipulation which takes place after our INIT phase is run will -not be reflected in the calculated MRO. Just as with changing the C<@ISA>, you will need to call -C for any changes you make to take effect. +This module calculates the MRO for each requested class by interogatting the symbol tables of said classes. +So any symbol table manipulation which takes place after our INIT phase is run will not be reflected in +the calculated MRO. Just as with changing the C<@ISA>, you will need to call C for any +changes you make to take effect. -=back +=item Calling C from methods defined outside the class -=head1 TODO +There is an edge case when using C from within a subroutine which was created in a different +module than the one it is called from. It sounds complicated, but it really isn't. Here is an example which +will not work correctly: -=over 4 + *Foo::foo = sub { (shift)->next::method(@_) }; + +The problem exists because the anonymous subroutine being assigned to the glob C<*Foo::foo> will show up +in the call stack as being called C<__ANON__> and not C as you might expect. Since C +uses C to find the name of the method it was called in, it will fail in this case. -=item More tests +But fear not, there is a simple solution. The module C will reach into the perl internals and +assign a name to an anonymous subroutine for you. Simply do this: + + use Sub::Name 'subname'; + *Foo::foo = subname 'Foo::foo' => sub { (shift)->next::method(@_) }; -You can never have enough tests :) +and things will Just Work. Of course this is not always possible to do, but to be honest, I just can't +manage to find a workaround for it, so until someone gives me a working patch this will be a known +limitation of this module. =back diff --git a/t/01_MRO.t b/t/01_MRO.t index 04ad0e8..5865612 100644 --- a/t/01_MRO.t +++ b/t/01_MRO.t @@ -47,6 +47,9 @@ This tests the classic diamond inheritence pattern. use Class::C3; } +Class::C3::initialize(); + + is_deeply( [ Class::C3::calculateMRO('Diamond_D') ], [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ], diff --git a/t/02_MRO.t b/t/02_MRO.t index f04b193..d4bf02c 100644 --- a/t/02_MRO.t +++ b/t/02_MRO.t @@ -86,6 +86,8 @@ Level 0 0 | A | (more specialized) use Class::C3; } +Class::C3::initialize(); + is_deeply( [ Class::C3::calculateMRO('Test::F') ], [ qw(Test::F Test::O) ], diff --git a/t/03_MRO.t b/t/03_MRO.t index f5ce4c7..a13294f 100644 --- a/t/03_MRO.t +++ b/t/03_MRO.t @@ -94,6 +94,8 @@ Level 0 0 | A | use Class::C3; } +Class::C3::initialize(); + is_deeply( [ Class::C3::calculateMRO('Test::A') ], [ qw(Test::A Test::B Test::E Test::C Test::D Test::F Test::O) ], diff --git a/t/04_MRO.t b/t/04_MRO.t index 1543a84..1e9bbba 100644 --- a/t/04_MRO.t +++ b/t/04_MRO.t @@ -65,6 +65,8 @@ example taken from: L use base ('Intelligent', 'Humanoid'); } +Class::C3::initialize(); + is_deeply( [ c3::calculateMRO('Vulcan') ], [ qw(Vulcan Intelligent Sentient Humanoid BiPedal LifeForm Object) ], diff --git a/t/05_MRO.t b/t/05_MRO.t index 0591fab..d3c6b77 100644 --- a/t/05_MRO.t +++ b/t/05_MRO.t @@ -24,6 +24,8 @@ From the parrot test t/pmc/object-meths.t =cut +Class::C3::initialize(); + is_deeply( [ c3::calculateMRO('t::lib::F') ], [ qw(t::lib::F t::lib::C t::lib::D t::lib::A t::lib::B t::lib::E) ], diff --git a/t/06_MRO.t b/t/06_MRO.t index 8cfadd5..de8db0f 100644 --- a/t/06_MRO.t +++ b/t/06_MRO.t @@ -52,6 +52,8 @@ while building DBIx::Class. Thanks Matt!!!! sub foo { 'Diamond_D::foo => ' . (shift)->next::method } } +Class::C3::initialize(); + is_deeply( [ Class::C3::calculateMRO('Diamond_D') ], [ qw(Diamond_D Diamond_C Diamond_B Diamond_A) ], diff --git a/t/10_Inconsistent_hierarchy.t b/t/10_Inconsistent_hierarchy.t index 85ba0c6..2378ea3 100644 --- a/t/10_Inconsistent_hierarchy.t +++ b/t/10_Inconsistent_hierarchy.t @@ -46,6 +46,8 @@ except TypeError: use base ('XY', 'YX'); } +Class::C3::initialize(); + eval { # now try to calculate the MRO # and watch it explode :) diff --git a/t/20_reinitialize.t b/t/20_reinitialize.t index 680276b..7dce5d4 100644 --- a/t/20_reinitialize.t +++ b/t/20_reinitialize.t @@ -46,6 +46,8 @@ Start with this: use Class::C3; } +Class::C3::initialize(); + is_deeply( [ Class::C3::calculateMRO('Diamond_D') ], [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ], diff --git a/t/21_C3_with_overload.t b/t/21_C3_with_overload.t index e612568..d6bd9b4 100644 --- a/t/21_C3_with_overload.t +++ b/t/21_C3_with_overload.t @@ -32,6 +32,8 @@ BEGIN { use Class::C3; } +Class::C3::initialize(); + my $x = InheritingFromOverloadedTest->new(); isa_ok($x, 'InheritingFromOverloadedTest'); diff --git a/t/22_uninitialize.t b/t/22_uninitialize.t index e5068d2..4ffaf50 100644 --- a/t/22_uninitialize.t +++ b/t/22_uninitialize.t @@ -49,6 +49,8 @@ BEGIN { our %hello = (h => 1, e => 2, l => "3 & 4", o => 5) } +Class::C3::initialize(); + is(Diamond_D->hello, 'Diamond_C::hello', '... method resolves with the correct MRO'); is(Diamond_D->goodbye, 'Diamond_C::goodbye', '... method resolves with the correct MRO'); diff --git a/t/30_next_method.t b/t/30_next_method.t index ab0fa31..db724c9 100644 --- a/t/30_next_method.t +++ b/t/30_next_method.t @@ -53,6 +53,8 @@ This tests the classic diamond inheritence pattern. sub foo { 'Diamond_D::foo => ' . (shift)->next::method() } } +Class::C3::initialize(); + is_deeply( [ Class::C3::calculateMRO('Diamond_D') ], [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ], diff --git a/t/31_next_method_skip.t b/t/31_next_method_skip.t index eac7cec..26912f0 100644 --- a/t/31_next_method_skip.t +++ b/t/31_next_method_skip.t @@ -55,6 +55,8 @@ This tests the classic diamond inheritence pattern. } +Class::C3::initialize(); + is_deeply( [ Class::C3::calculateMRO('Diamond_D') ], [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ], diff --git a/t/32_next_method_edge_cases.t b/t/32_next_method_edge_cases.t index 94e79bf..5af7004 100644 --- a/t/32_next_method_edge_cases.t +++ b/t/32_next_method_edge_cases.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 12; BEGIN { use_ok('Class::C3'); @@ -36,12 +36,13 @@ BEGIN { use warnings; use Class::C3; our @ISA = ('Foo'); - } + } my $bar = Bar->new(); isa_ok($bar, 'Bar'); isa_ok($bar, 'Foo'); + # test it working with with Sub::Name SKIP: { eval 'use Sub::Name'; skip "Sub::Name is required for this test", 3 if $@; @@ -53,9 +54,37 @@ BEGIN { *{'Bar::bar'} = $m; } + Class::C3::initialize(); + can_ok($bar, 'bar'); my $value = eval { $bar->bar() }; ok(!$@, '... calling bar() succedded') || diag $@; is($value, 'Foo::bar', '... got the right return value too'); } + + # test it failing without Sub::Name + { + package Baz; + use strict; + use warnings; + use Class::C3; + our @ISA = ('Foo'); + } + + my $baz = Baz->new(); + isa_ok($baz, 'Baz'); + isa_ok($baz, 'Foo'); + + { + my $m = sub { (shift)->next::method() }; + { + no strict 'refs'; + *{'Baz::bar'} = $m; + } + + Class::C3::initialize(); + + eval { $baz->bar() }; + ok($@, '... calling bar() with next::method failed') || diag $@; + } } \ No newline at end of file diff --git a/t/33_next_method_used_with_NEXT.t b/t/33_next_method_used_with_NEXT.t index fba980d..b2e4843 100644 --- a/t/33_next_method_used_with_NEXT.t +++ b/t/33_next_method_used_with_NEXT.t @@ -45,6 +45,8 @@ BEGIN { sub foo { 'Baz::foo => ' . (shift)->NEXT::foo } } +Class::C3::initialize(); + is(Foo->foo, 'Foo::foo', '... got the right value from Foo->foo'); is(Fuz->foo, 'Fuz::foo => Foo::foo', '... got the right value from Fuz->foo'); is(Bar->foo, 'Bar::foo => Foo::foo', '... got the right value from Bar->foo'); diff --git a/t/34_next_method_in_eval.t b/t/34_next_method_in_eval.t index 0776c6a..f782cd6 100644 --- a/t/34_next_method_in_eval.t +++ b/t/34_next_method_in_eval.t @@ -42,6 +42,8 @@ This tests the use of an eval{} block to wrap a next::method call. } } +Class::C3::initialize(); + like(B->foo, qr/^A::foo died/, 'method resolved inside eval{}'); diff --git a/t/35_next_method_in_anon.t b/t/35_next_method_in_anon.t index cca371e..67342b5 100644 --- a/t/35_next_method_in_anon.t +++ b/t/35_next_method_in_anon.t @@ -53,6 +53,8 @@ anonymous subroutine. } } +Class::C3::initialize(); + is(B->foo, "B::foo => A::foo", 'method resolved inside anonymous sub');