From: Stevan Little Date: Thu, 24 Nov 2005 04:45:33 +0000 (+0000) Subject: Class::C3 - 0.07 release; X-Git-Tag: 0_07^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f7facd7b73c20ba048f0f6c0baea399ba8db10ed;p=gitmo%2FClass-C3.git Class::C3 - 0.07 release; --- diff --git a/ChangeLog b/ChangeLog index bb69c86..9c211f2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,15 @@ Revision history for Perl extension Class::C3. -0.06 - +0.07 - Wed, Nov 23, 2005 + * all bugs found by, and fixes provided by Matt S. Trout * + - fixed issue caused when module is imported more than once + - fixed subtle bug in how next::method is calculated + - added test for this + + - added util/visualize_c3.pl tool, which visualizes C3 + dispatch order using GraphViz + +0.06 - Tues, Nov 15, 2005 - added Sub::Name to dependencies (even though it is just for the tests) - removed OS X resource fork which slipped into the tar.gz diff --git a/MANIFEST b/MANIFEST index eff3a5b..749dc2a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -10,6 +10,7 @@ t/02_MRO.t t/03_MRO.t t/04_MRO.t t/05_MRO.t +t/06_MRO.t t/10_Inconsistent_hierarchy.t t/20_reinitialize.t t/21_C3_with_overload.t @@ -25,3 +26,4 @@ t/lib/C.pm t/lib/D.pm t/lib/E.pm t/lib/F.pm +util/visualize_c3.pl diff --git a/Makefile.PL b/Makefile.PL index 8df0ff9..ab808e4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -6,6 +6,7 @@ WriteMakefile( 'Test::More' => 0.47, 'Test::Exception' => 0.15, 'Scalar::Util' => 1.10, - 'Sub::Name' => 0 + 'Sub::Name' => 0, + 'NEXT' => 0, } ); diff --git a/README b/README index bb4f26e..e2886be 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Class::C3 version 0.06 +Class::C3 version 0.07 =========================== INSTALLATION diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm index 6ca3999..3055c17 100644 --- a/lib/Class/C3.pm +++ b/lib/Class/C3.pm @@ -6,7 +6,7 @@ use warnings; use Scalar::Util 'blessed'; -our $VERSION = '0.06'; +our $VERSION = '0.07'; # this is our global stash of both # MRO's and method dispatch tables @@ -22,7 +22,7 @@ our $VERSION = '0.06'; # has_overload_fallback => (1 | 0) # } # -my %MRO; +our %MRO; # use these for debugging ... sub _dump_MRO_table { %MRO } @@ -36,7 +36,7 @@ sub import { return if $TURN_OFF_C3; # make a note to calculate $class # during INIT phase - $MRO{$class} = undef; + $MRO{$class} = undef unless exists $MRO{$class}; } ## initializers @@ -205,7 +205,7 @@ use warnings; use Scalar::Util 'blessed'; -our $VERSION = '0.03'; +our $VERSION = '0.04'; our %METHOD_CACHE; @@ -228,6 +228,8 @@ sub method { no strict 'refs'; my $found; foreach my $class (@MRO) { + next if (defined $Class::C3::MRO{$class} && + defined $Class::C3::MRO{$class}{methods}{$label}); last if (defined ($found = *{$class . '::' . $label}{CODE})); } diff --git a/t/06_MRO.t b/t/06_MRO.t new file mode 100644 index 0000000..8cfadd5 --- /dev/null +++ b/t/06_MRO.t @@ -0,0 +1,62 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 3; + +BEGIN { + use_ok('Class::C3'); + # uncomment this line, and re-run the + # test to see the normal p5 dispatch order + #$Class::C3::TURN_OFF_C3 = 1; +} + +=pod + +This tests a strange bug found by Matt S. Trout +while building DBIx::Class. Thanks Matt!!!! + + + / \ + + \ / + + +=cut + +{ + package Diamond_A; + use Class::C3; + + sub foo { 'Diamond_A::foo' } +} +{ + package Diamond_B; + use base 'Diamond_A'; + use Class::C3; + + sub foo { 'Diamond_B::foo => ' . (shift)->next::method } +} +{ + package Diamond_C; + use Class::C3; + use base 'Diamond_A'; + +} +{ + package Diamond_D; + use base ('Diamond_C', 'Diamond_B'); + use Class::C3; + + sub foo { 'Diamond_D::foo => ' . (shift)->next::method } +} + +is_deeply( + [ Class::C3::calculateMRO('Diamond_D') ], + [ qw(Diamond_D Diamond_C Diamond_B Diamond_A) ], + '... got the right MRO for Diamond_D'); + +is(Diamond_D->foo, + 'Diamond_D::foo => Diamond_B::foo => Diamond_A::foo', + '... got the right next::method dispatch path'); diff --git a/util/visualize_c3.pl b/util/visualize_c3.pl new file mode 100644 index 0000000..7a328d7 --- /dev/null +++ b/util/visualize_c3.pl @@ -0,0 +1,83 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +=pod + +This is a visualization tool to help with +understanding large MI hierarchies. It will +output a DOT file for rendering with Graphviz. + +NOTE: +This program is currently very primative, and +may break under some circumstances. If you +encounter one of those circumstances, please +email me about it so that I can improve this +tool. + +GRAPH LEGEND: +In the graphs the green arrows are the ISA, +and the red arrows are the C3 dispatch order. + +=cut + +use Class::C3 (); + +@ARGV || die "usage : visualize_c3.pl | "; + +my ($class, $OUT); +if (scalar @ARGV == 1) { + $class = shift @ARGV; + eval "use $class"; + die "Could not load '$class' :\n$@" if $@; +} +else { + my $file = shift @ARGV; + $class = shift @ARGV; + $OUT = shift @ARGV; + do $file; + die "Could not load '$file' :\n$@" if $@; +} + +Class::C3->initialize(); + +my @MRO = Class::C3::calculateMRO($class); + +sub get_class_str { + my $class = shift; + (join "_" => (split '::' => $class)); +} + +my $output = "graph test {\n"; + +my $prev; +foreach my $class (@MRO) { + my $class_str = get_class_str($class); + $output .= "node_${class_str} [ label = \"" . $class . "\" ];\n"; + { + no strict 'refs'; + foreach my $super (@{"${class}::ISA"}) { + $output .= "node_" . get_class_str($super) . + " -- node_${class_str}" . + " [ dir = back, color = green ];\n"; + } + } + if ($prev) { + $output .= "node_${class_str} -- node_${prev} [ dir = back, color = red ];\n"; + } + $prev = $class_str; +} + +$output .= "}\n"; + +warn $output; + +if ($OUT) { + open OUT, ">", $OUT || die "could not open '$OUT' for output"; + print OUT $output; + close OUT; +} +else { + print $output; +} \ No newline at end of file