From: Brandon L Black <blblack@gmail.com>
Date: Fri, 11 May 2007 04:14:32 +0000 (+0000)
Subject: linear_isa code, basic tests
X-Git-Tag: 0.02~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ed71cabbfc7415db88afaa876557ee0b8085a8f6;hp=399a1dc707d49515a13c25c3bfb3bfbbcc42c09a;p=gitmo%2FMRO-Compat.git

linear_isa code, basic tests
---

diff --git a/lib/MRO/Compat.pm b/lib/MRO/Compat.pm
index ca32464..81721ef 100644
--- a/lib/MRO/Compat.pm
+++ b/lib/MRO/Compat.pm
@@ -87,7 +87,36 @@ methods from C<UNIVERSAL> and its parents.
 
 =cut
 
+sub __get_linear_isa_dfs {
+    no strict 'refs';
+
+    my $classname = shift;
+
+    my @lin = ($classname);
+    my %stored;
+    foreach my $parent (@{"$classname\::ISA"}) {
+        my $plin = __get_linear_isa_dfs($parent);
+        foreach (@$plin) {
+            next if exists $stored{$_};
+            push(@lin, $_);
+            $stored{$_} = 1;
+        }
+    }
+    return \@lin;
+}
+
 sub __get_linear_isa {
+    my ($classname, $type) = @_;
+    die "mro::get_mro requires a classname" if !$classname;
+
+    $type ||= __get_mro($classname);
+    if($type eq 'dfs') {
+        return __get_linear_isa_dfs($classname);
+    }
+    elsif($type eq 'c3') {
+        return [Class::C3::calculateMRO($classname)];
+    }
+    die "type argument must be 'dfs' or 'c3'";
 }
 
 =head2 mro::import
@@ -118,10 +147,9 @@ Returns the MRO of the given class (either C<c3> or C<dfs>).
 =cut
 
 sub __get_mro {
-    my $classname = shift
+    my $classname = shift;
     die "mro::get_mro requires a classname" if !$classname;
-    if($C3_INSTALLED && exists $Class::C3::MRO{$classname}
-       && $Class::C3::_initialized) {
+    if($C3_INSTALLED && exists $Class::C3::MRO{$classname}) {
         return 'c3';
     }
     return 'dfs';
diff --git a/t/01use.t b/t/01use.t
new file mode 100644
index 0000000..747e4f2
--- /dev/null
+++ b/t/01use.t
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+    use_ok('MRO::Compat');
+}
diff --git a/t/02pod.t b/t/02pod.t
new file mode 100644
index 0000000..4ae1af3
--- /dev/null
+++ b/t/02pod.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/03pod_coverage.t b/t/03pod_coverage.t
new file mode 100644
index 0000000..62defbe
--- /dev/null
+++ b/t/03pod_coverage.t
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+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();
diff --git a/t/10basic.t b/t/10basic.t
new file mode 100644
index 0000000..7eebe5d
--- /dev/null
+++ b/t/10basic.t
@@ -0,0 +1,24 @@
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+BEGIN {
+    use_ok('MRO::Compat');
+}
+
+{
+    package AAA; our @ISA = qw//;
+    package BBB; our @ISA = qw/AAA/;
+    package CCC; our @ISA = qw/AAA/;
+    package DDD; our @ISA = qw/AAA/;
+    package EEE; our @ISA = qw/BBB CCC DDD/;
+    package FFF; our @ISA = qw/EEE DDD/;
+    package GGG; our @ISA = qw/FFF/;
+}
+
+is_deeply(
+  mro::get_linear_isa('GGG'),
+  [ 'GGG', 'FFF', 'EEE', 'BBB', 'AAA', 'CCC', 'DDD' ]
+);