From: Brandon L Black 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;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 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 or C). =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' ] +);