--- /dev/null
+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;
+
--- /dev/null
+Revision history for Perl extension Class::C3::XS
+
--- /dev/null
+^_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
--- /dev/null
+
+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;
--- /dev/null
+
+#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
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('Class::C3');
+}
\ No newline at end of file
--- /dev/null
+#!/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');
--- /dev/null
+#!/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
--- /dev/null
+#!/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');
--- /dev/null
+#!/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
--- /dev/null
+#!/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');
+
--- /dev/null
+#!/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');
--- /dev/null
+#!/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');
--- /dev/null
+#!/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');
--- /dev/null
+#!/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 }
--- /dev/null
+#!/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');
+
--- /dev/null
+#!/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');
--- /dev/null
+#!/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');
--- /dev/null
+#!/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');
--- /dev/null
+#!/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
--- /dev/null
+#!/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');
+
--- /dev/null
+#!/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{}');
+
+
--- /dev/null
+#!/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');
+
+
--- /dev/null
+package t::lib::A;
+use c3;
+1;
\ No newline at end of file
--- /dev/null
+package t::lib::B;
+use c3;
+1;
\ No newline at end of file
--- /dev/null
+package t::lib::C;
+use c3;
+use base ('t::lib::A', 't::lib::B');
+1;
\ No newline at end of file
--- /dev/null
+package t::lib::D;
+use c3;
+use base ('t::lib::A', 't::lib::E');
+1;
\ No newline at end of file
--- /dev/null
+package t::lib::E;
+use c3;
+1;
\ No newline at end of file
--- /dev/null
+package t::lib::F;
+use c3;
+use base ('t::lib::C', 't::lib::D');
+1;
\ No newline at end of file
--- /dev/null
+#!/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();
--- /dev/null
+#!/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
projects / gitmo/Class-C3-XS.git / commitdiff