Class::C3 - version 0.08 for release

diff --git a/ChangeLog b/ChangeLog
index 9c211f2..5b4f28c 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 Revision history for Perl extension Class::C3.
 
+0.08 - Wed, Dec 28, 2005
+    - adjusted &_remove_method_dispatch_table to be more 
+      discriminating about what it deletes. Thanks to 
+      Matt S. Trout for this fix.
+    - tweaked &_merge to avoid un-needed looping. Thanks to 
+      Audrey Tang for this fix.
+    - added better support for calling next::method within 
+      an eval BLOCK. Thanks to Justin Guenther for this patch
+      and test.
+
 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

diff --git a/MANIFEST b/MANIFEST
index 749dc2a..cfd58d1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -18,6 +18,7 @@ t/30_next_method.t
 t/31_next_method_skip.t
 t/32_next_method_edge_cases.t
 t/33_next_method_used_with_NEXT.t
+t/34_next_method_in_eval.t
 t/pod.t
 t/pod_coverage.t
 t/lib/A.pm

diff --git a/README b/README
index e2886be..e90e94d 100644 (file)
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Class::C3 version 0.07
+Class::C3 version 0.08
 ===========================
 
 INSTALLATION

diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm
index 3055c17..1af7d12 100644 (file)
--- a/lib/Class/C3.pm
+++ b/lib/Class/C3.pm
@@ -6,7 +6,7 @@ use warnings;
 
 use Scalar::Util 'blessed';
 
-our $VERSION = '0.07';
+our $VERSION = '0.08';
 
 # this is our global stash of both 
 # MRO's and method dispatch tables
@@ -139,7 +139,9 @@ sub _remove_method_dispatch_table {
     no strict 'refs';
     delete ${"${class}::"}{"()"} if $MRO{$class}->{has_overload_fallback};    
     foreach my $method (keys %{$MRO{$class}->{methods}}) {
-        delete ${"${class}::"}{$method};
+        delete ${"${class}::"}{$method}
+          if \&{"${class}::${method}"} eq 
+             $MRO{$class}->{methods}->{$method}->{code};        
     }   
 }
 
@@ -169,7 +171,7 @@ sub _merge {
                 # 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};      
+                ++$nothead && last if exists $in_tail{$cand};      
             }
             last unless $nothead; # leave the loop with our canidate ...
             $reject = $cand;
@@ -205,12 +207,17 @@ use warnings;
 
 use Scalar::Util 'blessed';
 
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 
 our %METHOD_CACHE;
 
 sub method {
-    my @label    = (split '::', (caller(1))[3]);
+    my $level = 1;
+    my $method_caller;
+    while ($method_caller = (caller($level++))[3]) {
+        last unless $method_caller eq '(eval)';
+    }
+    my @label    = (split '::', $method_caller);    
     my $label    = pop @label;
     my $caller   = join '::' => @label;    
     my $self     = $_[0];
@@ -465,14 +472,15 @@ You can never have enough tests :)
 
 =head1 CODE COVERAGE
 
-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.
+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.
 
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
  File                           stmt   bran   cond    sub    pod   time  total
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Class/C3.pm                    99.2   93.3   66.7   96.0  100.0   92.8   96.3
+ Class/C3.pm                    98.6   88.6   75.0   96.0  100.0   70.4   95.2
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Total                          99.2   93.3   66.7   96.0  100.0   92.8   96.3
+ Total                          98.6   88.6   75.0   96.0  100.0   70.4   95.2
  ---------------------------- ------ ------ ------ ------ ------ ------ ------
 
 =head1 SEE ALSO

diff --git a/t/34_next_method_in_eval.t b/t/34_next_method_in_eval.t
new file mode 100644 (file)
index 0000000..0776c6a
--- /dev/null
+++ b/t/34_next_method_in_eval.t
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+BEGIN {
+    use lib 'opt', '../opt', '..';    
+    use_ok('c3');
+}
+
+=pod
+
+This tests the use of an eval{} block to wrap a next::method call.
+
+=cut
+
+{
+    package A;
+    use c3; 
+
+    sub foo {
+      die 'A::foo died';
+      return 'A::foo succeeded';
+    }
+}
+
+{
+    package B;
+    use base 'A';
+    use c3; 
+    
+    sub foo {
+      eval {
+        return 'B::foo => ' . (shift)->next::method();
+      };
+
+      if ($@) {
+        return $@;
+      }
+    }
+}
+
+like(B->foo, 
+   qr/^A::foo died/, 
+   'method resolved inside eval{}');
+
+