0.19, to push XS 0.07 fixes

[gitmo/Class-C3.git] / lib / Class / C3.pm

diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm
index 8e7dc0a..2c1d336 100644 (file)
--- a/lib/Class/C3.pm
+++ b/lib/Class/C3.pm
@@ -4,32 +4,27 @@ package Class::C3;
 use strict;
 use warnings;
 
-our $VERSION = '0.15_01';
-
-# Class::C3 defines Class::C3::* in pure perl
-# if mro, it does nothing else
-#   elsif Class::C3::XS, do nothing else
-#     else load next.pm
-# Class::C3::XS defines the same routines as next.pm,
-#  and also redefines (suppress warning) calculateMRO
-#  (ditto for anything else in Class::C3::* we want to
-#   XS-ize).
+our $VERSION = '0.19';
 
 our $C3_IN_CORE;
+our $C3_XS;
 
 BEGIN {
-    eval "require mro"; # XXX in the future, this should be a version check
-    if($@) {
-        die $@ if $@ !~ /locate/;
-        eval "require Class::C3::XS";
-        if($@) {
-            die $@ if $@ !~ /locate/;
-            eval "require Algorithm::C3; require Class::C3::next";
-            die $@ if $@;
-        }
+    if($] > 5.009_004) {
+        $C3_IN_CORE = 1;
+        require mro;
     }
     else {
-        $C3_IN_CORE = 1;
+        eval "require Class::C3::XS";
+        my $error = $@;
+        if(!$error) {
+            $C3_XS = 1;
+        }
+        else {
+            die $error if $error !~ /\blocate\b/;
+            require Algorithm::C3;
+            require Class::C3::next;
+        }
     }
 }
 
@@ -121,7 +116,7 @@ sub _calculate_method_dispatch_table {
     no strict 'refs';
     my @MRO = calculateMRO($class, $merge_cache);
     $MRO{$class} = { MRO => \@MRO };
-    my $has_overload_fallback = 0;
+    my $has_overload_fallback;
     my %methods;
     # NOTE: 
     # we do @MRO[1 .. $#MRO] here because it
@@ -132,7 +127,7 @@ sub _calculate_method_dispatch_table {
         # have use "fallback", then we want to
         # grab that value 
         $has_overload_fallback = ${"${local}::()"} 
-            if defined ${"${local}::()"};
+            if !defined $has_overload_fallback && defined ${"${local}::()"};
         foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
             # skip if already overriden in local class
             next unless !defined *{"${class}::$method"}{CODE};
@@ -159,8 +154,13 @@ sub _apply_method_dispatch_table {
     my $class = shift;
     no strict 'refs';
     ${"${class}::()"} = $MRO{$class}->{has_overload_fallback}
-        if $MRO{$class}->{has_overload_fallback};
+        if !defined &{"${class}::()"}
+           && defined $MRO{$class}->{has_overload_fallback};
     foreach my $method (keys %{$MRO{$class}->{methods}}) {
+        if ( $method =~ /^\(/ ) {
+            my $orig = $MRO{$class}->{methods}->{$method}->{orig};
+            ${"${class}::$method"} = $$orig if defined $$orig;
+        }
         *{"${class}::$method"} = $MRO{$class}->{methods}->{$method}->{code};
     }    
 }
@@ -169,7 +169,7 @@ sub _remove_method_dispatch_tables {
     return if $C3_IN_CORE;
     foreach my $class (keys %MRO) {
         _remove_method_dispatch_table($class);
-    }       
+    }
 }
 
 sub _remove_method_dispatch_table {
@@ -181,20 +181,33 @@ sub _remove_method_dispatch_table {
         delete ${"${class}::"}{$method}
             if defined *{"${class}::${method}"}{CODE} && 
                (*{"${class}::${method}"}{CODE} eq $MRO{$class}->{methods}->{$method}->{code});       
-    }   
+    }
 }
 
 sub calculateMRO {
     my ($class, $merge_cache) = @_;
 
-    return @{mro::get_linear_isa($class)} if $C3_IN_CORE;
-
     return Algorithm::C3::merge($class, sub { 
         no strict 'refs'; 
         @{$_[0] . '::ISA'};
     }, $merge_cache);
 }
 
+# Method overrides to support 5.9.5+ or Class::C3::XS
+
+sub _core_calculateMRO { @{mro::get_linear_isa($_[0], 'c3')} }
+
+if($C3_IN_CORE) {
+    no warnings 'redefine';
+    *Class::C3::calculateMRO = \&_core_calculateMRO;
+}
+elsif($C3_XS) {
+    no warnings 'redefine';
+    *Class::C3::calculateMRO = \&Class::C3::XS::calculateMRO;
+    *Class::C3::_calculate_method_dispatch_table
+        = \&Class::C3::XS::_calculate_method_dispatch_table;
+}
+
 1;
 
 __END__
@@ -463,18 +476,19 @@ limitation of this module.
 
 =back
 
-=head1 CODE COVERAGE
+=head1 COMPATIBILITY
 
-I use B<Devel::Cover> to test the code coverage of my tests, below is the B<Devel::Cover> report on this 
-module's test suite.
+If your software requires Perl 5.9.5 or higher, you do not need L<Class::C3>, you can simply C<use mro 'c3'>, and not worry about C<initialize()>, avoid some of the above caveats, and get the best possible performance.  See L<mro> for more details.
+
+If your software is meant to work on earlier Perls, use L<Class::C3> as documented here.  L<Class::C3> will detect Perl 5.9.5+ and take advantage of the core support when available.
+
+=head1 Class::C3::XS
+
+This module will load L<Class::C3::XS> if it's installed and you are running on a Perl version older than 5.9.5.  Installing this is recommended when possible, as it results in significant performance improvements (but unlike the 5.9.5+ core support, it still has all of the same caveats as L<Class::C3>).
+
+=head1 CODE COVERAGE
 
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
- File                           stmt   bran   cond    sub    pod   time  total
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Class/C3.pm                    98.3   84.4   80.0   96.2  100.0   98.4   94.4
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Total                          98.3   84.4   80.0   96.2  100.0   98.4   94.4
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
+L<Devel::Cover> was reporting 94.4% overall test coverage earlier in this module's life.  Currently, the test suite does things that break under coverage testing, but it is fair to assume the coverage is still close to that value.
 
 =head1 SEE ALSO