From: Brandon L Black <blblack@gmail.com>
Date: Fri, 5 Jan 2007 02:19:29 +0000 (+0000)
Subject: adding the some preliminary junk
X-Git-Tag: 0.02~22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FClass-C3-XS.git;a=commitdiff_plain;h=8995e8271e0f7f7b9c0942a4425e8a44099bf608

adding the some preliminary junk
---

diff --git a/Build.PL b/Build.PL
new file mode 100644
index 0000000..4559bb6
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,22 @@
+use Module::Build;
+
+use strict;
+
+my $build = Module::Build->new(
+    module_name => 'Class::C3::XS',
+    license => 'perl',
+    optional => {},
+    build_requires => {
+        'Test::More' => '0.47',
+        'Test::Exception' => 0.15,
+    },
+    create_makefile_pl => 'traditional',
+    create_readme => 1,
+    recursive_test_files => 1,
+    add_to_cleanup => [
+        'META.yml', '*.bak', '*.gz', 'Makefile.PL',
+    ],
+);
+
+$build->create_build_script;
+
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..5d83af9
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,2 @@
+Revision history for Perl extension Class::C3::XS
+
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..795aeb0
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,18 @@
+^_build
+^Build$
+^blib
+~$
+\.bak$
+^MANIFEST\.SKIP$
+CVS
+\.svn
+\.DS_Store
+cover_db
+\..*\.sw.?$
+^Makefile$
+^pm_to_blib$
+^MakeMaker-\d
+^blibdirs$
+\.old$
+^#.*#$
+^\.#
\ No newline at end of file
diff --git a/lib/Class/C3/XS.pm b/lib/Class/C3/XS.pm
new file mode 100644
index 0000000..e4efd50
--- /dev/null
+++ b/lib/Class/C3/XS.pm
@@ -0,0 +1,253 @@
+
+package Class::C3::XS;
+
+our $VERSION = '0.15';
+
+=pod
+
+=head1 NAME
+
+Class::C3::XS - The XS implementation of Class::C3
+
+=head1 DESCRIPTION
+
+This is the XS implementation of L<Class::C3>.  The main L<Class::C3> package will
+first attempt to load L<Class::C3::XS>, and then failing that, will fall back to 
+L<Class::C3::PurePerl>.  Do not use this package directly, use L<Class::C3> instead.
+
+=head1 AUTHOR
+
+Stevan Little, E<lt>stevan@iinteractive.comE<gt>
+
+Brandon L. Black, E<lt>blblack@gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2005, 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
+=cut
+
+package # hide me from PAUSE
+    Class::C3;
+
+use strict;
+use warnings;
+
+use Scalar::Util 'blessed';
+use Algorithm::C3;
+
+# this is our global stash of both 
+# MRO's and method dispatch tables
+# the structure basically looks like
+# this:
+#
+#   $MRO{$class} = {
+#      MRO => [ <class precendence list> ],
+#      methods => {
+#          orig => <original location of method>,
+#          code => \&<ref to original method>
+#      },
+#      has_overload_fallback => (1 | 0)
+#   }
+#
+our %MRO;
+
+# use these for debugging ...
+sub _dump_MRO_table { %MRO }
+our $TURN_OFF_C3 = 0;
+
+# state tracking for initialize()/uninitialize()
+our $_initialized = 0;
+
+sub import {
+    my $class = caller();
+    # skip if the caller is main::
+    # since that is clearly not relevant
+    return if $class eq 'main';
+    return if $TURN_OFF_C3;
+    # make a note to calculate $class 
+    # during INIT phase
+    $MRO{$class} = undef unless exists $MRO{$class};
+}
+
+## initializers
+
+sub initialize {
+    # why bother if we don't have anything ...
+    return unless keys %MRO;
+    if($_initialized) {
+        uninitialize();
+        $MRO{$_} = undef foreach keys %MRO;
+    }
+    _calculate_method_dispatch_tables();
+    _apply_method_dispatch_tables();
+    %next::METHOD_CACHE = ();
+    $_initialized = 1;
+}
+
+sub uninitialize {
+    # why bother if we don't have anything ...
+    return unless keys %MRO;    
+    _remove_method_dispatch_tables();    
+    %next::METHOD_CACHE = ();
+    $_initialized = 0;
+}
+
+sub reinitialize { goto &initialize }
+
+## functions for applying C3 to classes
+
+sub _calculate_method_dispatch_tables {
+    my %merge_cache;
+    foreach my $class (keys %MRO) {
+        _calculate_method_dispatch_table($class, \%merge_cache);
+    }
+}
+
+sub _calculate_method_dispatch_table {
+    my ($class, $merge_cache) = @_;
+    no strict 'refs';
+    my @MRO = calculateMRO($class, $merge_cache);
+    $MRO{$class} = { MRO => \@MRO };
+    my $has_overload_fallback = 0;
+    my %methods;
+    # NOTE: 
+    # we do @MRO[1 .. $#MRO] here because it
+    # makes no sense to interogate the class
+    # which you are calculating for. 
+    foreach my $local (@MRO[1 .. $#MRO]) {
+        # if overload has tagged this module to 
+        # have use "fallback", then we want to
+        # grab that value 
+        $has_overload_fallback = ${"${local}::()"} 
+            if defined ${"${local}::()"};
+        foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
+            # skip if already overriden in local class
+            next unless !defined *{"${class}::$method"}{CODE};
+            $methods{$method} = {
+                orig => "${local}::$method",
+                code => \&{"${local}::$method"}
+            } unless exists $methods{$method};
+        }
+    }    
+    # now stash them in our %MRO table
+    $MRO{$class}->{methods} = \%methods; 
+    $MRO{$class}->{has_overload_fallback} = $has_overload_fallback;        
+}
+
+sub _apply_method_dispatch_tables {
+    foreach my $class (keys %MRO) {
+        _apply_method_dispatch_table($class);
+    }     
+}
+
+sub _apply_method_dispatch_table {
+    my $class = shift;
+    no strict 'refs';
+    ${"${class}::()"} = $MRO{$class}->{has_overload_fallback}
+        if $MRO{$class}->{has_overload_fallback};
+    foreach my $method (keys %{$MRO{$class}->{methods}}) {
+        *{"${class}::$method"} = $MRO{$class}->{methods}->{$method}->{code};
+    }    
+}
+
+sub _remove_method_dispatch_tables {
+    foreach my $class (keys %MRO) {
+        _remove_method_dispatch_table($class);
+    }       
+}
+
+sub _remove_method_dispatch_table {
+    my $class = shift;
+    no strict 'refs';
+    delete ${"${class}::"}{"()"} if $MRO{$class}->{has_overload_fallback};    
+    foreach my $method (keys %{$MRO{$class}->{methods}}) {
+        delete ${"${class}::"}{$method}
+            if defined *{"${class}::${method}"}{CODE} && 
+               (*{"${class}::${method}"}{CODE} eq $MRO{$class}->{methods}->{$method}->{code});       
+    }   
+}
+
+## functions for calculating C3 MRO
+
+sub calculateMRO {
+    my ($class, $merge_cache) = @_;
+    return Algorithm::C3::merge($class, sub { 
+        no strict 'refs'; 
+        @{$_[0] . '::ISA'};
+    }, $merge_cache);
+}
+
+package  # hide me from PAUSE
+    next; 
+
+use strict;
+use warnings;
+
+our $VERSION = 0.15;
+
+use Scalar::Util 'blessed';
+
+our %METHOD_CACHE;
+
+sub method {
+    my $indirect = caller() =~ /^(?:next|maybe::next)$/;
+    my $level = $indirect ? 2 : 1;
+     
+    my ($method_caller, $label, @label);
+    while ($method_caller = (caller($level++))[3]) {
+      @label = (split '::', $method_caller);
+      $label = pop @label;
+      last unless
+        $label eq '(eval)' ||
+        $label eq '__ANON__';
+    }
+    my $caller   = join '::' => @label;    
+    my $self     = $_[0];
+    my $class    = blessed($self) || $self;
+    
+    my $method = $METHOD_CACHE{"$class|$caller|$label"} ||= do {
+        
+        my @MRO = Class::C3::calculateMRO($class);
+        
+        my $current;
+        while ($current = shift @MRO) {
+            last if $caller eq $current;
+        }
+        
+        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}));
+        }
+        
+        $found;
+    };
+
+    return $method if $indirect;
+
+    die "No next::method '$label' found for $self" if !$method;
+
+    goto &{$method};
+}
+
+sub can { method($_[0]) }
+
+package  # hide me from PAUSE
+    maybe::next; 
+
+use strict;
+use warnings;
+
+our $VERSION = 0.15;
+
+sub method { (next::method($_[0]) || return)->(@_) }
+
+1;
diff --git a/lib/Class/C3/XS.xs b/lib/Class/C3/XS.xs
new file mode 100644
index 0000000..d5e62f1
--- /dev/null
+++ b/lib/Class/C3/XS.xs
@@ -0,0 +1,177 @@
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+ 
+STATIC I32
+__dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
+    I32 i;
+    for (i = startingblock; i >= 0; i--) {
+	register const PERL_CONTEXT * const cx = &cxstk[i];
+	switch (CxTYPE(cx)) {
+	default:
+	    continue;
+	case CXt_EVAL:
+	case CXt_SUB:
+	case CXt_FORMAT:
+	    DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i));
+	    return i;
+	}
+    }
+    return i;
+}
+
+MODULE = Class::C3::XS	PACKAGE = next
+
+#ifdef XXX_NEW_PERL /* some sort of cpp check for a perl that has mro_linear */
+
+/* we want to define next::can, next::method, and maybe::next::method */
+
+CV*
+canxs(self)
+    SV* self
+  PPCODE:
+    register I32 cxix = __dopoptosub_at(cxstack, cxstack_ix);
+    register const PERL_CONTEXT *cx;
+    register const PERL_CONTEXT *ccstack = cxstack;
+    const PERL_SI *top_si = PL_curstackinfo;
+    HV* selfstash;
+    //sv_dump(self);
+    if(sv_isobject(self)) {
+        selfstash = SvSTASH(SvRV(self));
+    }
+    else {
+        selfstash = gv_stashsv(self, 0);
+    }
+    assert(selfstash);
+
+    for (;;) {
+        /* we may be in a higher stacklevel, so dig down deeper */
+        while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
+            top_si = top_si->si_prev;
+            ccstack = top_si->si_cxstack;
+            cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
+        }
+        if (cxix < 0) {
+            croak("next::/maybe::next:: must be used in method context");
+        }
+    
+        /* caller() should not report the automatic calls to &DB::sub */
+        if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
+            continue;
+
+        cx = &ccstack[cxix];
+        if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+            const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
+            /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
+               field below is defined for any cx. */
+            /* caller() should not report the automatic calls to &DB::sub */
+            if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
+                cx = &ccstack[dbcxix];
+            }
+            if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+	        GV * const cvgv = CvGV(ccstack[cxix].blk_sub.cv);
+	        /* So is ccstack[dbcxix]. */
+	        if (isGV(cvgv)) { /* we found a real sub here */
+                    const char *stashname;
+                    const char *fq_subname;
+                    const char *subname;
+                    STRLEN fq_subname_len;
+                    STRLEN stashname_len;
+                    STRLEN subname_len;
+                    GV * found_gv;
+	            SV * const sv = sv_2mortal(newSV(0));
+
+	            gv_efullname3(sv, cvgv, NULL);
+
+                    fq_subname = SvPVX(sv);
+                    fq_subname_len = SvCUR(sv);
+/*                    warn("fqsubname is %s", fq_subname); */
+                    
+                    subname = strrchr(fq_subname, ':');
+                    if(subname) {
+                        subname++;
+                        subname_len = fq_subname_len - (subname - fq_subname);
+                        stashname = fq_subname;
+                        stashname_len = subname - fq_subname - 2;
+                        if(subname_len == 8 && strEQ(subname, "__ANON__")) {
+                            croak("Cannot use next::method/next::can/maybe::next::method from an anonymous sub");
+                        }
+                        else {
+                            GV** gvp;
+                            AV* linear_av;
+                            SV** linear_svp;
+                            SV* linear_sv;
+                            HV* curstash;
+                            GV* candidate = NULL;
+                            CV* cand_cv = NULL;
+                            const char *hvname;
+                            I32 items;
+
+                            hvname = HvNAME_get(selfstash);
+                            if (!hvname)
+                              Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
+
+                            linear_av = mro_linear(selfstash); /* has ourselves at the top of the list */
+                            sv_2mortal((SV*)linear_av);
+
+                            linear_svp = AvARRAY(linear_av) + 1; /* skip over self */
+                            items = AvFILLp(linear_av); /* no +1, to skip over self */
+
+                            while (items--) {
+                                linear_sv = *linear_svp++;
+                                assert(linear_sv);
+                                if(strEQ(SvPVX(linear_sv), stashname)) break;
+                            }
+
+                            while (items--) {
+                                linear_sv = *linear_svp++;
+                                assert(linear_sv);
+                                curstash = gv_stashsv(linear_sv, FALSE);
+
+                                if (!curstash) {
+                                    if (ckWARN(WARN_MISC))
+                                        Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
+                                            (void*)linear_sv, hvname);
+                                    continue;
+                                }
+
+                                assert(curstash);
+
+                                gvp = (GV**)hv_fetch(curstash, subname, subname_len, 0);
+                                if (!gvp) continue;
+                                candidate = *gvp;
+                                assert(candidate);
+                                if (SvTYPE(candidate) != SVt_PVGV) gv_init(candidate, curstash, subname, subname_len, TRUE);
+                                if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
+                                    PUSHs((SV*)cand_cv);
+                                    return;
+                                }
+                            }
+    
+                            /* Check UNIVERSAL without caching */
+                            if((candidate = gv_fetchmeth(NULL, subname, subname_len, 1))) {
+                                PUSHs((SV*)GvCV(candidate));
+                                return;
+                            }
+                            PUSHs(&PL_sv_undef);
+                            return;
+                        }
+                    }
+	        }
+            }
+
+	    cxix = __dopoptosub_at(ccstack, cxix - 1);
+        }
+
+
+#else /* mro_linear stuff not in core, so do some helpers for the pure-perl variant */
+
+/* we want to define two helper functions:
+   1) A replacement for Alg::C3::merge based on mro_linear_c3, but without the mro_meta caching parts.
+      it should have optional merge cache support just like Alg::C3 does, but only support @ISA, not
+      generic parents.  Call it Class::C3::calculateMRO_XS or something.
+   2) A fast "fetch the most recent caller's package/sub-names", based on the xs can function above,
+      to speed up the top half of pure-perl next::method.
+*/
+#endif
diff --git a/t/00_load.t b/t/00_load.t
new file mode 100644
index 0000000..9703116
--- /dev/null
+++ b/t/00_load.t
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+    use_ok('Class::C3');
+}
\ No newline at end of file
diff --git a/t/01_MRO.t b/t/01_MRO.t
new file mode 100644
index 0000000..5865612
--- /dev/null
+++ b/t/01_MRO.t
@@ -0,0 +1,76 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+
+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 the classic diamond inheritence pattern.
+
+   <A>
+  /   \
+<B>   <C>
+  \   /
+   <D>
+
+=cut
+
+{
+    package Diamond_A;
+    use Class::C3; 
+    sub hello { 'Diamond_A::hello' }
+}
+{
+    package Diamond_B;
+    use base 'Diamond_A';
+    use Class::C3;     
+}
+{
+    package Diamond_C;
+    use Class::C3;    
+    use base 'Diamond_A';     
+    
+    sub hello { 'Diamond_C::hello' }
+}
+{
+    package Diamond_D;
+    use base ('Diamond_B', 'Diamond_C');
+    use Class::C3;    
+}
+
+Class::C3::initialize();
+
+
+is_deeply(
+    [ Class::C3::calculateMRO('Diamond_D') ],
+    [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
+    '... got the right MRO for Diamond_D');
+
+is(Diamond_D->hello, 'Diamond_C::hello', '... method resolved itself as expected');
+
+is(Diamond_D->can('hello')->(), 'Diamond_C::hello', '... can(method) resolved itself as expected');
+is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_C::hello', '... can(method) resolved itself as expected');
+
+# now undo the C3
+Class::C3::uninitialize();
+
+is(Diamond_D->hello, 'Diamond_A::hello', '... old method resolution has been restored');
+
+is(Diamond_D->can('hello')->(), 'Diamond_A::hello', '... can(method) resolution has been restored');
+is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_A::hello', '... can(method) resolution has been restored');
+
+Class::C3::initialize();
+
+is(Diamond_D->hello, 'Diamond_C::hello', '... C3 method restored itself as expected');
+
+is(Diamond_D->can('hello')->(), 'Diamond_C::hello', '... C3 can(method) restored itself as expected');
+is(UNIVERSAL::can("Diamond_D", 'hello')->(), 'Diamond_C::hello', '... C3 can(method) restored itself as expected');
diff --git a/t/02_MRO.t b/t/02_MRO.t
new file mode 100644
index 0000000..d4bf02c
--- /dev/null
+++ b/t/02_MRO.t
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 15;
+
+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 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;
+    use Class::C3; 
+    
+    package Test::F;   
+    use Class::C3;  
+    use base 'Test::O';        
+    
+    package Test::E;
+    use base 'Test::O';    
+    use Class::C3;     
+    
+    sub C_or_E { 'Test::E' }
+
+    package Test::D;
+    use Class::C3; 
+    use base 'Test::O';     
+    
+    sub C_or_D { 'Test::D' }       
+      
+    package Test::C;
+    use base ('Test::D', 'Test::F');
+    use Class::C3; 
+    
+    sub C_or_D { 'Test::C' }
+    sub C_or_E { 'Test::C' }    
+        
+    package Test::B;    
+    use Class::C3; 
+    use base ('Test::D', 'Test::E');    
+        
+    package Test::A;    
+    use base ('Test::B', 'Test::C');
+    use Class::C3;    
+}
+
+Class::C3::initialize();
+
+is_deeply(
+    [ Class::C3::calculateMRO('Test::F') ],
+    [ qw(Test::F Test::O) ],
+    '... got the right MRO for Test::F');
+
+is_deeply(
+    [ Class::C3::calculateMRO('Test::E') ],
+    [ qw(Test::E Test::O) ],
+    '... got the right MRO for Test::E');    
+
+is_deeply(
+    [ Class::C3::calculateMRO('Test::D') ],
+    [ qw(Test::D Test::O) ],
+    '... got the right MRO for Test::D');       
+
+is_deeply(
+    [ Class::C3::calculateMRO('Test::C') ],
+    [ qw(Test::C Test::D Test::F Test::O) ],
+    '... got the right MRO for Test::C'); 
+
+is_deeply(
+    [ Class::C3::calculateMRO('Test::B') ],
+    [ qw(Test::B Test::D Test::E Test::O) ],
+    '... got the right MRO for Test::B');     
+
+is_deeply(
+    [ Class::C3::calculateMRO('Test::A') ],
+    [ qw(Test::A Test::B Test::C Test::D Test::E Test::F Test::O) ],
+    '... got the right MRO for Test::A');  
+    
+is(Test::A->C_or_D, 'Test::C', '... got the expected method output');
+is(Test::A->can('C_or_D')->(), 'Test::C', '... can got the expected method output');
+
+is(Test::A->C_or_E, 'Test::C', '... got the expected method output');
+is(Test::A->can('C_or_E')->(), 'Test::C', '... can got the expected method output');
+
+# remove the C3
+Class::C3::uninitialize();
+
+is(Test::A->C_or_D, 'Test::D', '...  old method resolution has been restored');
+is(Test::A->can('C_or_D')->(), 'Test::D', '...  old can(method) resolution has been restored');
+
+is(Test::A->C_or_E, 'Test::E', '...  old method resolution has been restored');
+is(Test::A->can('C_or_E')->(), 'Test::E', '...  old can(method) resolution has been restored');
+
+    
\ No newline at end of file
diff --git a/t/03_MRO.t b/t/03_MRO.t
new file mode 100644
index 0000000..a13294f
--- /dev/null
+++ b/t/03_MRO.t
@@ -0,0 +1,117 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+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 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()
+(<class '__main__.A'>, <class '__main__.B'>, <class '__main__.E'>,
+<class '__main__.C'>, <class '__main__.D'>, <class '__main__.F'>,
+<type 'object'>)
+
+=cut
+
+{
+    package Test::O;
+    use Class::C3;
+    
+    sub O_or_D { 'Test::O' }
+    sub O_or_F { 'Test::O' }    
+    
+    package Test::F;
+    use base 'Test::O';
+    use Class::C3;
+    
+    sub O_or_F { 'Test::F' }    
+    
+    package Test::E;
+    use base 'Test::O';
+    use Class::C3;
+        
+    package Test::D;
+    use base 'Test::O';    
+    use Class::C3;
+    
+    sub O_or_D { 'Test::D' }
+    sub C_or_D { 'Test::D' }
+        
+    package Test::C;
+    use base ('Test::D', 'Test::F');
+    use Class::C3;    
+
+    sub C_or_D { 'Test::C' }
+    
+    package Test::B;
+    use base ('Test::E', 'Test::D');
+    use Class::C3;
+        
+    package Test::A;
+    use base ('Test::B', 'Test::C');
+    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) ],
+    '... got the right MRO for Test::A');      
+    
+is(Test::A->O_or_D, 'Test::D', '... got the right method dispatch');    
+is(Test::A->O_or_F, 'Test::F', '... got the right method dispatch');   
+
+# NOTE: 
+# this test is particularly interesting because the p5 dispatch
+# would actually call Test::D before Test::C and Test::D is a
+# subclass of Test::C 
+is(Test::A->C_or_D, 'Test::C', '... got the right method dispatch');    
+
+Class::C3::uninitialize();
+
+is(Test::A->O_or_D, 'Test::O', '... old dispatch order is restored');    
+is(Test::A->O_or_F, 'Test::O', '... old dispatch order is restored');   
+is(Test::A->C_or_D, 'Test::D', '... old dispatch order is restored');   
diff --git a/t/04_MRO.t b/t/04_MRO.t
new file mode 100644
index 0000000..1e9bbba
--- /dev/null
+++ b/t/04_MRO.t
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+BEGIN {
+    use lib 'opt', '../opt', '..';
+    use_ok('c3');
+}
+
+=pod
+
+example taken from: L<http://gauss.gwydiondylan.org/books/drm/drm_50.html>
+
+         Object
+           ^
+           |
+        LifeForm 
+         ^    ^
+        /      \
+   Sentient    BiPedal
+      ^          ^
+      |          |
+ Intelligent  Humanoid
+       ^        ^
+        \      /
+         Vulcan
+
+ define class <sentient> (<life-form>) end class;
+ define class <bipedal> (<life-form>) end class;
+ define class <intelligent> (<sentient>) end class;
+ define class <humanoid> (<bipedal>) end class;
+ define class <vulcan> (<intelligent>, <humanoid>) end class;
+
+=cut
+
+{
+    package Object;    
+    use c3;
+    
+    package LifeForm;
+    use c3;
+    use base 'Object';
+    
+    package Sentient;
+    use c3;
+    use base 'LifeForm';
+    
+    package BiPedal;
+    use c3;    
+    use base 'LifeForm';
+    
+    package Intelligent;
+    use c3;    
+    use base 'Sentient';
+    
+    package Humanoid;
+    use c3;    
+    use base 'BiPedal';
+    
+    package Vulcan;
+    use c3;    
+    use base ('Intelligent', 'Humanoid');
+}
+
+Class::C3::initialize();
+
+is_deeply(
+    [ c3::calculateMRO('Vulcan') ],
+    [ qw(Vulcan Intelligent Sentient Humanoid BiPedal LifeForm Object) ],
+    '... got the right MRO for the Vulcan Dylan Example');  
\ No newline at end of file
diff --git a/t/05_MRO.t b/t/05_MRO.t
new file mode 100644
index 0000000..d3c6b77
--- /dev/null
+++ b/t/05_MRO.t
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+BEGIN {
+    use lib 'opt', '../opt', '..';
+    use_ok('c3');
+    use_ok('t::lib::F');    
+}
+
+=pod 
+
+From the parrot test t/pmc/object-meths.t
+
+ A   B A   E
+  \ /   \ /
+   C     D
+    \   /
+     \ /
+      F
+
+=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) ],
+    '... got the right MRO for t::lib::F');  
+
diff --git a/t/06_MRO.t b/t/06_MRO.t
new file mode 100644
index 0000000..de8db0f
--- /dev/null
+++ b/t/06_MRO.t
@@ -0,0 +1,64 @@
+#!/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!!!! 
+
+   <A>
+  /   \
+<C>   <B>
+  \   /
+   <D>
+
+=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 }    
+}
+
+Class::C3::initialize();
+
+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/t/10_Inconsistent_hierarchy.t b/t/10_Inconsistent_hierarchy.t
new file mode 100644
index 0000000..2378ea3
--- /dev/null
+++ b/t/10_Inconsistent_hierarchy.t
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+BEGIN {
+    use_ok('Class::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;
+    use Class::C3;
+    
+    package Y;
+    use Class::C3;    
+    
+    package XY;
+    use Class::C3;
+    use base ('X', 'Y');
+    
+    package YX;
+    use Class::C3;
+    use base ('Y', 'X');
+    
+    package Z;
+    # use Class::C3; << Dont do this just yet ...
+    use base ('XY', 'YX');
+}
+
+Class::C3::initialize();
+
+eval { 
+    # now try to calculate the MRO
+    # and watch it explode :)
+    Class::C3::calculateMRO('Z') 
+};
+#diag $@;
+like($@, qr/^Inconsistent hierarchy/, '... got the right error with an inconsistent hierarchy');
diff --git a/t/20_reinitialize.t b/t/20_reinitialize.t
new file mode 100644
index 0000000..7dce5d4
--- /dev/null
+++ b/t/20_reinitialize.t
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+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
+
+Start with this:
+
+   <A>
+  /   \
+<B>   <C>
+  \   /
+   <D>
+
+=cut
+
+{
+    package Diamond_A;
+    use Class::C3; 
+    sub hello { 'Diamond_A::hello' }
+}
+{
+    package Diamond_B;
+    use base 'Diamond_A';
+    use Class::C3;        
+}
+{
+    package Diamond_C;
+    use Class::C3;    
+    use base 'Diamond_A';     
+    sub hello { 'Diamond_C::hello' }
+}
+{
+    package Diamond_D;
+    use base ('Diamond_B', 'Diamond_C');
+    use Class::C3;    
+}
+
+Class::C3::initialize();
+
+is_deeply(
+    [ Class::C3::calculateMRO('Diamond_D') ],
+    [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
+    '... got the right MRO for Diamond_D');
+
+=pod
+
+Then change it to this:
+
+<E>   <A>
+  \  /   \
+   <B>   <C>
+     \   /
+      <D>
+
+=cut
+
+{
+    package Diamond_E;
+    use Class::C3;      
+    sub hello { 'Diamond_E::hello' }      
+}
+
+{
+    no strict 'refs';
+    unshift @{"Diamond_B::ISA"} => 'Diamond_E';
+}
+
+is_deeply(
+    [ Class::C3::calculateMRO('Diamond_D') ],
+    [ qw(Diamond_D Diamond_B Diamond_E Diamond_C Diamond_A) ],
+    '... got the new MRO for Diamond_D');
+
+is(Diamond_D->hello, 'Diamond_C::hello', '... method still resolves with old MRO');
+
+Class::C3::reinitialize();
+
+is(Diamond_D->hello, 'Diamond_E::hello', '... method resolves with reinitialized MRO');
diff --git a/t/21_C3_with_overload.t b/t/21_C3_with_overload.t
new file mode 100644
index 0000000..d6bd9b4
--- /dev/null
+++ b/t/21_C3_with_overload.t
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+BEGIN {
+    use_ok('Class::C3');
+}
+
+{
+    package BaseTest;
+    use strict;
+    use warnings;
+    use Class::C3;
+    
+    package OverloadingTest;
+    use strict;
+    use warnings;
+    use Class::C3;
+    use base 'BaseTest';        
+    use overload '""' => sub { ref(shift) . " stringified" },
+                 fallback => 1;
+    
+    sub new { bless {} => shift }    
+    
+    package InheritingFromOverloadedTest;
+    use strict;
+    use warnings;
+    use base 'OverloadingTest';
+    use Class::C3;
+}
+
+Class::C3::initialize();
+
+my $x = InheritingFromOverloadedTest->new();
+isa_ok($x, 'InheritingFromOverloadedTest');
+
+my $y = OverloadingTest->new();
+isa_ok($y, 'OverloadingTest');
+
+is("$x", 'InheritingFromOverloadedTest stringified', '... got the right value when stringifing');
+is("$y", 'OverloadingTest stringified', '... got the right value when stringifing');
+
+ok(($y eq 'OverloadingTest stringified'), '... eq was handled correctly');
+
+my $result;
+eval { 
+    $result = $x eq 'InheritingFromOverloadedTest stringified' 
+};
+ok(!$@, '... this should not throw an exception');
+ok($result, '... and we should get the true value');
+
+#use Data::Dumper;
+#diag Dumper { Class::C3::_dump_MRO_table }
diff --git a/t/22_uninitialize.t b/t/22_uninitialize.t
new file mode 100644
index 0000000..4ffaf50
--- /dev/null
+++ b/t/22_uninitialize.t
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+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
+
+   <A>
+  /   \
+<B>   <C>
+  \   /
+   <D>
+
+=cut
+
+{
+    package Diamond_A;
+    use Class::C3; 
+    sub hello { 'Diamond_A::hello' }
+}
+{
+    package Diamond_B;
+    use base 'Diamond_A';
+    use Class::C3;        
+}
+{
+    package Diamond_C;
+    use Class::C3;    
+    use base 'Diamond_A';     
+    sub goodbye { 'Diamond_C::goodbye' }
+    sub hello   { 'Diamond_C::hello'   }
+}
+{
+    package Diamond_D;
+    use base ('Diamond_B', 'Diamond_C');
+    use Class::C3;    
+    
+    our @hello = qw(h e l l o);
+    our $hello = 'hello';
+    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');
+
+{
+    no warnings 'redefine';
+    no strict 'refs';
+    *{"Diamond_D::goodbye"} = sub { 'Diamond_D::goodbye' };
+}
+
+is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... method overwritten');
+
+is($Diamond_D::hello, 'hello', '... our SCALAR package vars are here');
+is_deeply(
+    \@Diamond_D::hello, 
+    [ qw(h e l l o) ],
+    '... our ARRAY package vars are here');
+is_deeply(
+    \%Diamond_D::hello, 
+    { h => 1, e => 2, l => "3 & 4", o => 5 },
+    '... our HASH package vars are here');  
+
+Class::C3::uninitialize();
+
+is(Diamond_D->hello, 'Diamond_A::hello', '... method resolves with reinitialized MRO');
+is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... uninitialize does not mess with the manually changed method');
+
+is($Diamond_D::hello, 'hello', '... our SCALAR package vars are still here');
+is_deeply(
+    \@Diamond_D::hello, 
+    [ qw(h e l l o) ],
+    '... our ARRAY package vars are still here');
+is_deeply(
+    \%Diamond_D::hello, 
+    { h => 1, e => 2, l => "3 & 4", o => 5 },
+    '... our HASH package vars are still here');    
+
diff --git a/t/23_multi_init.t b/t/23_multi_init.t
new file mode 100644
index 0000000..ebe9a72
--- /dev/null
+++ b/t/23_multi_init.t
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+BEGIN {
+    use_ok('Class::C3');
+}
+
+=pod
+
+rt.cpan.org # 21558
+
+If compile-time code from another module issues a [re]initialize() part-way
+through the process of setting up own our modules, that shouldn't prevent
+our own initialize() call from working properly.
+
+=cut
+
+{
+    package TestMRO::A;
+    use Class::C3;
+    sub testmethod { 42 }
+
+    package TestMRO::B;
+    use base 'TestMRO::A';
+    use Class::C3;
+
+    package TestMRO::C;
+    use base 'TestMRO::A';
+    use Class::C3;
+    sub testmethod { shift->next::method + 1 }
+
+    package TestMRO::D;
+    BEGIN { Class::C3::initialize }
+    use base 'TestMRO::B';
+    use base 'TestMRO::C';
+    use Class::C3;
+    sub new {
+        my $class = shift;
+        my $self = {};
+        bless $self => $class;
+    }
+}
+
+Class::C3::initialize;
+is(TestMRO::D->new->testmethod, 43, 'double-initialize works ok');
diff --git a/t/30_next_method.t b/t/30_next_method.t
new file mode 100644
index 0000000..db724c9
--- /dev/null
+++ b/t/30_next_method.t
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+BEGIN {
+    use lib 'opt', '../opt', '..';    
+    use_ok('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 the classic diamond inheritence pattern.
+
+   <A>
+  /   \
+<B>   <C>
+  \   /
+   <D>
+
+=cut
+
+{
+    package Diamond_A;
+    use c3; 
+    sub hello { 'Diamond_A::hello' }
+    sub foo { 'Diamond_A::foo' }       
+}
+{
+    package Diamond_B;
+    use base 'Diamond_A';
+    use c3;     
+    sub foo { 'Diamond_B::foo => ' . (shift)->next::method() }       
+}
+{
+    package Diamond_C;
+    use c3;    
+    use base 'Diamond_A';     
+
+    sub hello { 'Diamond_C::hello => ' . (shift)->next::method() }
+    sub foo { 'Diamond_C::foo => ' . (shift)->next::method() }   
+}
+{
+    package Diamond_D;
+    use base ('Diamond_B', 'Diamond_C');
+    use c3; 
+    
+    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) ],
+    '... got the right MRO for Diamond_D');
+
+is(Diamond_D->hello, 'Diamond_C::hello => Diamond_A::hello', '... method resolved itself as expected');
+
+is(Diamond_D->can('hello')->('Diamond_D'), 
+   'Diamond_C::hello => Diamond_A::hello', 
+   '... can(method) resolved itself as expected');
+   
+is(UNIVERSAL::can("Diamond_D", 'hello')->('Diamond_D'), 
+   'Diamond_C::hello => Diamond_A::hello', 
+   '... can(method) resolved itself as expected');
+
+is(Diamond_D->foo, 
+    'Diamond_D::foo => Diamond_B::foo => Diamond_C::foo => Diamond_A::foo', 
+    '... method foo resolved itself as expected');
diff --git a/t/31_next_method_skip.t b/t/31_next_method_skip.t
new file mode 100644
index 0000000..7af8035
--- /dev/null
+++ b/t/31_next_method_skip.t
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+
+BEGIN {
+    use lib 'opt', '../opt', '..';    
+    use_ok('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 the classic diamond inheritence pattern.
+
+   <A>
+  /   \
+<B>   <C>
+  \   /
+   <D>
+
+=cut
+
+{
+    package Diamond_A;
+    use c3; 
+    sub bar { 'Diamond_A::bar' }        
+    sub baz { 'Diamond_A::baz' }
+}
+{
+    package Diamond_B;
+    use base 'Diamond_A';
+    use c3;    
+    sub baz { 'Diamond_B::baz => ' . (shift)->next::method() }         
+}
+{
+    package Diamond_C;
+    use c3;    
+    use base 'Diamond_A';     
+    sub foo { 'Diamond_C::foo' }   
+    sub buz { 'Diamond_C::buz' }     
+    
+    sub woz { 'Diamond_C::woz' }
+    sub maybe { 'Diamond_C::maybe' }         
+}
+{
+    package Diamond_D;
+    use base ('Diamond_B', 'Diamond_C');
+    use c3; 
+    sub foo { 'Diamond_D::foo => ' . (shift)->next::method() } 
+    sub bar { 'Diamond_D::bar => ' . (shift)->next::method() }   
+    sub buz { 'Diamond_D::buz => ' . (shift)->baz() }  
+    sub fuz { 'Diamond_D::fuz => ' . (shift)->next::method() }  
+    
+    sub woz { 'Diamond_D::woz can => ' . ((shift)->next::can() ? 1 : 0) }
+    sub noz { 'Diamond_D::noz can => ' . ((shift)->next::can() ? 1 : 0) }
+
+    sub maybe { 'Diamond_D::maybe => ' . ((shift)->maybe::next::method() || 0) }
+    sub moybe { 'Diamond_D::moybe => ' . ((shift)->maybe::next::method() || 0) }             
+
+}
+
+Class::C3::initialize();
+
+is_deeply(
+    [ Class::C3::calculateMRO('Diamond_D') ],
+    [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
+    '... got the right MRO for Diamond_D');
+
+is(Diamond_D->foo, 'Diamond_D::foo => Diamond_C::foo', '... skipped B and went to C correctly');
+is(Diamond_D->bar, 'Diamond_D::bar => Diamond_A::bar', '... skipped B & C and went to A correctly');
+is(Diamond_D->baz, 'Diamond_B::baz => Diamond_A::baz', '... called B method, skipped C and went to A correctly');
+is(Diamond_D->buz, 'Diamond_D::buz => Diamond_B::baz => Diamond_A::baz', '... called D method dispatched to , different method correctly');
+eval { Diamond_D->fuz };
+like($@, qr/^No next::method 'fuz' found for Diamond_D/, '... cannot re-dispatch to a method which is not there');
+
+is(Diamond_D->woz, 'Diamond_D::woz can => 1', '... can re-dispatch figured out correctly');
+is(Diamond_D->noz, 'Diamond_D::noz can => 0', '... cannot re-dispatch figured out correctly');
+
+is(Diamond_D->maybe, 'Diamond_D::maybe => Diamond_C::maybe', '... redispatched D to C when it exists');
+is(Diamond_D->moybe, 'Diamond_D::moybe => 0', '... quietly failed redispatch from D');
diff --git a/t/32_next_method_edge_cases.t b/t/32_next_method_edge_cases.t
new file mode 100644
index 0000000..5af7004
--- /dev/null
+++ b/t/32_next_method_edge_cases.t
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+BEGIN {   
+    use_ok('Class::C3');
+}
+
+{
+
+    {
+        package Foo;
+        use strict;
+        use warnings;
+        use Class::C3;
+        sub new { bless {}, $_[0] }
+        sub bar { 'Foo::bar' }
+    }
+
+    # call the submethod in the direct instance
+
+    my $foo = Foo->new();
+    isa_ok($foo, 'Foo');
+
+    can_ok($foo, 'bar');
+    is($foo->bar(), 'Foo::bar', '... got the right return value');    
+
+    # fail calling it from a subclass
+
+    {
+        package Bar;
+        use strict;
+        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 $@;
+    
+        my $m = sub { (shift)->next::method() };
+        Sub::Name::subname('Bar::bar', $m);
+        {
+            no strict 'refs';
+            *{'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
new file mode 100644
index 0000000..b2e4843
--- /dev/null
+++ b/t/33_next_method_used_with_NEXT.t
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    eval "use NEXT";
+    plan skip_all => "NEXT required for this test" if $@;
+    plan tests => 4;
+}
+
+{
+    package Foo;
+    use strict;
+    use warnings;
+    use Class::C3;
+    
+    sub foo { 'Foo::foo' }
+    
+    package Fuz;
+    use strict;
+    use warnings;
+    use Class::C3;    
+    use base 'Foo';
+
+    sub foo { 'Fuz::foo => ' . (shift)->next::method }
+        
+    package Bar;
+    use strict;
+    use warnings;    
+    use Class::C3;
+    use base 'Foo';
+
+    sub foo { 'Bar::foo => ' . (shift)->next::method }
+    
+    package Baz;
+    use strict;
+    use warnings;    
+    require NEXT; # load this as late as possible so we can catch the test skip
+
+    use base 'Bar', 'Fuz';
+    
+    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');
+
+is(Baz->foo, 'Baz::foo => Bar::foo => Fuz::foo => Foo::foo', '... got the right value using NEXT in a subclass of a C3 class');
+
diff --git a/t/34_next_method_in_eval.t b/t/34_next_method_in_eval.t
new file mode 100644
index 0000000..f782cd6
--- /dev/null
+++ b/t/34_next_method_in_eval.t
@@ -0,0 +1,51 @@
+#!/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 $@;
+      }
+    }
+}
+
+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
new file mode 100644
index 0000000..67342b5
--- /dev/null
+++ b/t/35_next_method_in_anon.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+BEGIN {
+    use lib 'opt', '../opt', '../blib/lib';    
+    use_ok('c3');
+}
+
+=pod
+
+This tests the successful handling of a next::method call from within an
+anonymous subroutine.
+
+=cut
+
+{
+    package A;
+    use c3; 
+
+    sub foo {
+      return 'A::foo';
+    }
+
+    sub bar {
+      return 'A::bar';
+    }
+}
+
+{
+    package B;
+    use base 'A';
+    use c3; 
+    
+    sub foo {
+      my $code = sub {
+        return 'B::foo => ' . (shift)->next::method();
+      };
+      return (shift)->$code;
+    }
+
+    sub bar {
+      my $code1 = sub {
+        my $code2 = sub {
+          return 'B::bar => ' . (shift)->next::method();
+        };
+        return (shift)->$code2;
+      };
+      return (shift)->$code1;
+    }
+}
+
+Class::C3::initialize();  
+
+is(B->foo, "B::foo => A::foo",
+   'method resolved inside anonymous sub');
+
+is(B->bar, "B::bar => A::bar",
+   'method resolved inside nested anonymous subs');
+
+
diff --git a/t/lib/A.pm b/t/lib/A.pm
new file mode 100644
index 0000000..74acfec
--- /dev/null
+++ b/t/lib/A.pm
@@ -0,0 +1,3 @@
+package t::lib::A;
+use c3;
+1;
\ No newline at end of file
diff --git a/t/lib/B.pm b/t/lib/B.pm
new file mode 100644
index 0000000..8d5d80f
--- /dev/null
+++ b/t/lib/B.pm
@@ -0,0 +1,3 @@
+package t::lib::B;
+use c3;
+1;
\ No newline at end of file
diff --git a/t/lib/C.pm b/t/lib/C.pm
new file mode 100644
index 0000000..608ea0c
--- /dev/null
+++ b/t/lib/C.pm
@@ -0,0 +1,4 @@
+package t::lib::C;
+use c3;
+use base ('t::lib::A', 't::lib::B');
+1;
\ No newline at end of file
diff --git a/t/lib/D.pm b/t/lib/D.pm
new file mode 100644
index 0000000..4ccb3de
--- /dev/null
+++ b/t/lib/D.pm
@@ -0,0 +1,4 @@
+package t::lib::D;
+use c3;    
+use base ('t::lib::A', 't::lib::E');
+1;
\ No newline at end of file
diff --git a/t/lib/E.pm b/t/lib/E.pm
new file mode 100644
index 0000000..4cb7b71
--- /dev/null
+++ b/t/lib/E.pm
@@ -0,0 +1,3 @@
+package t::lib::E;
+use c3;
+1;
\ No newline at end of file
diff --git a/t/lib/F.pm b/t/lib/F.pm
new file mode 100644
index 0000000..a53c2d7
--- /dev/null
+++ b/t/lib/F.pm
@@ -0,0 +1,4 @@
+package t::lib::F;
+use c3;
+use base ('t::lib::C', 't::lib::D');
+1;
\ No newline at end of file
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..4ae1af3
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,11 @@
+#!/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();
diff --git a/t/pod_coverage.t b/t/pod_coverage.t
new file mode 100644
index 0000000..84632f2
--- /dev/null
+++ b/t/pod_coverage.t
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    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({ also_private => [ qr/removeChildAt/ ] });
+}
\ No newline at end of file