Permalink
Browse files

Identify and Describe roles work, but no aliases yet

  • Loading branch information...
1 parent ef545fc commit bef72fa9677eb92366da2cf3189f1d370dc38832 Chris Fields committed Mar 25, 2010
Showing with 23 additions and 322 deletions.
  1. +5 −2 Makefile
  2. +3 −2 lib/Bio/Role/Describe.pm
  3. +11 −7 t/Describe.t
  4. +4 −0 t/Identify.t
  5. +0 −311 t/Range.bak
  6. 0 t/Range.t
View
@@ -2,8 +2,11 @@ PERL6=perl6
RAKUDO_DIR=<RAKUDO_DIR>
PERL6LIB='<PERL6LIB>:$(RAKUDO_DIR)'
-SOURCES= ./lib/Bio/Root/Root.pm \
-./lib/Bio/Role/Range.pm
+SOURCES= \
+ ./lib/Bio/Root/Root.pm \
+ ./lib/Bio/Role/Range.pm \
+ ./lib/Bio/Role/Describe.pm \
+ ./lib/Bio/Role/Identify.pm
PIRS=$(SOURCES:.pm=.pir)
@@ -1,9 +1,10 @@
-use Bio::Role::Aliased;
+#use Bio::Role::Aliased;
role Bio::Role::Describe {
# these are the primary data available that are similar to the BioPerl
# Bio::DescribableI interface.
has Str $.display_name is rw;
- has Str $.description is rw is aliased<desc>;
+ has Str $.description is rw;
+ #has Str $.description is rw is aliased<desc>;
}
View
@@ -1,17 +1,19 @@
use v6;
+BEGIN {
+ @*INC.push('./lib');
+}
+
use Test;
use Bio::Role::Describe;
-plan 6;
-
class Desc does Bio::Role::Describe { };
my $s = Desc.new(display_name => <ABCD1234>,
description => 'Hello, my name is Mr. Ed');
-is($s.display_name, 'ABCD1234');
-is($s.description, 'Hello, my name is Mr. Ed');
+is($s.display_name, 'ABCD1234', 'test display_name');
+is($s.description, 'Hello, my name is Mr. Ed', 'test description');
$s.display_name = 'WXYZ4567';
$s.description = 'Goodbye, Mr. Bond';
@@ -20,7 +22,9 @@ is($s.display_name, 'WXYZ4567');
# testing aliases out
is($s.description, 'Goodbye, Mr. Bond');
-is($s.desc, 'Goodbye, Mr. Bond');
-$s.desc = 'Frankly, my dear...';
-is($s.description, 'Frankly, my dear...');
+#is($s.desc, 'Goodbye, Mr. Bond'); # TODO: aliases don't work yet
+#$s.desc = 'Frankly, my dear...'; # TODO: set via alias
+#is($s.description, 'Frankly, my dear...');
+
+done_testing;
View
@@ -1,5 +1,9 @@
use v6;
+BEGIN {
+ @*INC.push('./lib');
+}
+
use Test;
use Bio::Role::Identify;
View
@@ -1,311 +0,0 @@
-use v6;
-
-use Test;
-use Bio::Role::Range;
-
-=begin Range tests
-
-Test out simple ranges. Locations will expand on these...
-
- r0 |--------->
- r1 |---------|
- r2 <---------|
-
- r3 |-->
- r4 |--|
- r5 <--|
-
- r6 |-------->
- r7 |--------|
- r8 <--------|
-
- r9 |-------->
- r10 |--------|
- r11 <--------|
-
-Logic table for overlaps, contains, equals
-
-m = method, o = overlaps() c = contains() e = equals
-st = strand tests, i = ignore, w = weak, s = strong
-
- r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11
- o c e o c e o c e o c e o c e o c e o c e o c e o c e o c e o c e o c e
- iwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiwsiws
-r0 111111111110110110100100100111111000110110000100100000111000000110000000100000000000000000000000000000000000
-r1 xxxxxxxxx110110110110110110110110000110110000110110000110000000110000000110000000000000000000000000000000000
-r2 xxxxxxxxxxxxxxxxxx111111111100100000110110000111111000100000000110000000111000000000000000000000000000000000
-r3 xxxxxxxxxxxxxxxxxxxxxxxxxxx111111111110110110100100100111000000110000000100000000000000000000000000000000000
-r4 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx110110110110110110110000000110000000110000000000000000000000000000000000
-r5 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111100000000110000000111000000000000000000000000000000000
-r6 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111110110110100100100111000000110000000100000000
-r7 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx110110110110110110110000000110000000110000000
-r8 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111100000000110000000111000000
-r9 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111110110110100100100
-r10 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx110110110110110110
-r11 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111
-
-=end Range tests
-
-class MyRange does Bio::Role::Range {};
-
-my @spans = (1 => 100, 25 => 75, 75 => 125, 101 => 150);
-
-my @ranges;
-
-for @spans -> $s {
- for (-1..1).reverse -> $strand {
- push @ranges, MyRange.new(start => $s->[0],
- end => $s->[1],
- strand => $strand);
- }
-}
-
-#does_ok($ranges[0],'Bio::Moose::Role::Range', 'Range role');
-#isa_ok($ranges[0],'MyRange', 'MyRange class');
-#ok(!$ranges[0]->isa('Bio::Moose::Role::Range'), 'Role consumed by class');
-#is($ranges[0]->start, 1);
-#is($ranges[0]->end, 100);
-#is($ranges[0]->strand, 1);
-#is($ranges[0]->length, 100);
-#is($ranges[1]->strand, 0);
-#is($ranges[2]->strand, -1);
-#is($ranges[11]->start, 101);
-#is($ranges[11]->end, 150);
-#is($ranges[11]->strand, -1);
-#is($ranges[11]->length, 50);
-#
-# see above for logic table
-#my %map = (
-#r0 => '111111111110110110100100100111111000110110000100100000111000000110000000100000000000000000000000000000000000',
-#r1 => 'xxxxxxxxx110110110110110110110110000110110000110110000110000000110000000110000000000000000000000000000000000',
-#r2 => 'xxxxxxxxxxxxxxxxxx111111111100100000110110000111111000100000000110000000111000000000000000000000000000000000',
-#r3 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxx111111111110110110100100100111000000110000000100000000000000000000000000000000000',
-#r4 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx110110110110110110110000000110000000110000000000000000000000000000000000',
-#r5 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111100000000110000000111000000000000000000000000000000000',
-#r6 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111110110110100100100111000000110000000100000000',
-#r7 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx110110110110110110110000000110000000110000000',
-#r8 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111100000000110000000111000000',
-#r9 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111110110110100100100',
-#r10 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx110110110110110110',
-#r11 => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx111111111',
-#);
-#
-## cover all variations
-#
-## logic table; uncomment code below for output
-##printf("%-2s %s\n",' ', join('',map {sprintf("r%-8d", $_)} (0..11)));
-##printf("%-2s %s\n",' ', ('o c e 'x12));
-##printf("%-2s %s\n",' ', ('iws'x36));
-#
-#for my $i (0..$#ranges) {
-# my $string = '';
-# my $istring = '';
-# for my $j ($i..$#ranges) {
-# for my $method (qw(overlaps contains equals)) {
-# for my $test (qw(ignore weak strong)) {
-# my $com = $ranges[$i]->$method($ranges[$j], $test);
-# my $inv = $ranges[$j]->$method($ranges[$i], $test);
-# #$istring .= ($inv == $com) ? 1 : 0; # for inverse logic table
-# $string .= $com;
-# }
-# }
-# }
-# ok(exists $map{'r'.$i});
-# is(sprintf("%s%s",'x' x ($i*9), $string), $map{'r'.$i}, "logic tests for ranges $i..$#ranges");
-# #printf("r%-2d %s%s\n",$i, 'x' x ($i*9), $string);
-#}
-#
-#=head1 Geometric tests
-#
-#With these ranges:
-#
-# r0 |--------->
-# r1 |---------|
-# r2 <---------|
-#
-# r3 |-->
-# r4 |--|
-# r5 <--|
-#
-# r6 |-------->
-# r7 |--------|
-# r8 <--------|
-#
-# r9 |-------->
-# r10 |--------|
-# r11 <--------|
-#
-# intersection of r0, r3, r6 => [75,75,1] for all st
-# intersection of r6, r9 => [101, 125, 1] for all st
-# intersection of r6, r10 => [101, 125, 0] for ignore, weak, undef for strong
-# intersection of r6, r11 => [101, 125, 0] for ignore, undef for weak & strong
-# intersection of r0, r6, r9 => undef for all
-#
-# union of r0, r3, r6 => [1,125,1] for all st
-# union of r6, r9 => [75, 150, 1] for all st
-# union of r6, r10 => [75, 150, 0] for all st
-# union of r6, r11 => [75, 150, 0] for all st
-# union of r0, r6, r9 => [1,150,1] for all st
-#
-#=cut
-#
-## geometric tests
-#
-#my %geo_tests =
-#('0,3,6' => { # intersection union
-# 'strong' => ['(75, 75) strand=1', '(1, 125) strand=1'],
-# 'weak' => ['(75, 75) strand=1', '(1, 125) strand=1'],
-# 'ignore' => ['(75, 75) strand=1', '(1, 125) strand=1'],
-# },
-# '6,9' => {
-# 'strong' => ['(101, 125) strand=1', '(75, 150) strand=1'],
-# 'weak' => ['(101, 125) strand=1', '(75, 150) strand=1'],
-# 'ignore' => ['(101, 125) strand=1', '(75, 150) strand=1'],
-# },
-# '6,10' => {
-# 'strong' => ['', '(75, 150) strand=0'],
-# 'weak' => ['(101, 125) strand=0', '(75, 150) strand=0'],
-# 'ignore' => ['(101, 125) strand=0', '(75, 150) strand=0'],
-# },
-# '6,11' => {
-# 'strong' => ['', '(75, 150) strand=0'],
-# 'weak' => ['', '(75, 150) strand=0'],
-# 'ignore' => ['(101, 125) strand=0', '(75, 150) strand=0'],
-# },
-# '0,6,9' => {
-# 'strong' => ['', '(1, 150) strand=1'],
-# 'weak' => ['', '(1, 150) strand=1'],
-# 'ignore' => ['', '(1, 150) strand=1'],
-# },
-#);
-#
-#for my $set (sort keys %geo_tests) {
-# my @ind = split(',',$set);
-# my ($primary, @rest) = @ranges[@ind];
-# for my $method (qw(intersection union)) {
-# for my $st (qw(ignore weak strong)) {
-# my $ind = $method eq 'intersection' ? 0 : 1;
-# #print ."\n";
-# my $test = $primary->$method(\@rest, $st);
-# my $string = (defined $test) ? $test->to_string : '';
-# is($string, $geo_tests{$set}->{$st}->[$ind],"$method on $set, strand test = $st");
-# }
-# }
-#}
-#
-#=head1 Subtraction
-#
-# As Ranges can be empty (length = 0), and just like any subtraction operator,
-# this method always gives a Range implementor back (unlike
-# Bio::RangeI::subtract()). May change based on comments.
-#
-# r0 |--------->
-# r1 |---------|
-# r2 <---------|
-#
-# r3 |-->
-# r4 |--|
-# r5 <--|
-#
-# r6 |-------->
-# r7 |--------|
-# r8 <--------|
-#
-# r9 |-------->
-# r10 |--------|
-# r11 <--------|
-#
-# subtraction of r3 from r0 => two Ranges [1, 24, 1] and [76, 100, 1]
-# subtraction of r0 from r3 => one Range [0,0,1] - empty
-# subtraction of r6 from r0 => one Range [1, 74, 1]
-# subtraction of r0 from r6 => one Range [101,125,1]
-# subtraction of r9 from r6 => one Range [75,100,1]
-# subtraction of r6 from r9 => one Range [126,150,1]
-# subtraction of r9 from r0 => original (or clone?) r0 Range [1, 100, 1]
-# subtraction of r0 from r9 => original (or clone?) r9 Range [101,150,1]
-#
-#=cut
-#
-#my %subtract_tests = ( # rx->subtract(ry) ry->subtract(rx)
-# '0,3' => {
-# 'strong' => ['(1, 24) strand=1,(76, 100) strand=1','(0, 0) strand=0'],
-# 'weak' => ['(1, 24) strand=1,(76, 100) strand=1','(0, 0) strand=0'],
-# 'ignore' => ['(1, 24) strand=1,(76, 100) strand=1','(0, 0) strand=0'],
-# },
-# '0,4' => {
-# 'strong' => ['(1, 100) strand=1', '(0, 0) strand=0'],
-# 'weak' => ['(1, 24) strand=1,(76, 100) strand=1','(0, 0) strand=0'],
-# 'ignore' => ['(1, 24) strand=1,(76, 100) strand=1','(0, 0) strand=0'],
-# },
-# '0,6' => {
-# 'strong' => ['(1, 74) strand=1', '(101, 125) strand=1'],
-# 'weak' => ['(1, 74) strand=1', '(101, 125) strand=1'],
-# 'ignore' => ['(1, 74) strand=1', '(101, 125) strand=1'],
-# },
-# '6,9' => {
-# 'strong' => ['(75, 100) strand=1', '(126, 150) strand=1'],
-# 'weak' => ['(75, 100) strand=1', '(126, 150) strand=1'],
-# 'ignore' => ['(75, 100) strand=1', '(126, 150) strand=1'],
-# },
-# '0,9' => {
-# 'strong' => ['(1, 100) strand=1', '(101, 150) strand=1'],
-# 'weak' => ['(1, 100) strand=1', '(101, 150) strand=1'],
-# 'ignore' => ['(1, 100) strand=1', '(101, 150) strand=1'],
-# },
-#);
-#
-#for my $set (sort keys %subtract_tests) {
-# my @ind = split(',',$set);
-# my ($r1, $r2) = @ranges[@ind];
-# for my $st (qw(ignore weak strong)) {
-# my @sub1 = $r1->subtract($r2, $st);
-# my $string = join(',',map {$_->to_string} @sub1);
-# is($string, $subtract_tests{$set}->{$st}->[0], "Subtract ".join(' from ',@ind).", strand test = $st");
-# my @sub2 = $r2->subtract($r1);
-# $string = join(',',map {$_->to_string} @sub2);
-# is($string, $subtract_tests{$set}->{$st}->[1], "Subtract ".join(' from ',reverse @ind).", strand test = $st");
-# }
-#}
-
-## test Range role
-#
-#class Foo does Bio::RangeR { };
-#
-#my $r1 = Foo.new(start => 1,
-# end => 100,
-# strand => 1);
-#
-#is($r1.start, 1);
-#is($r1.end, 100);
-#is($r1.strand, 1);
-#is($r1.length, 100);
-#
-## the following methods are currently abstract (yadas)
-##
-## these should be defined in more concise terms based on the
-## implementation (i.e. Locations, segments, etc.) as they may be
-## implementation-dependent
-##
-## Saying that, basic fallback methods may be defined
-#
-#eval_dies_ok('$r1.equals');
-#eval_dies_ok('$r1.overlaps');
-#eval_dies_ok('$r1.contains');
-#eval_dies_ok('$r1.intersection');
-#eval_dies_ok('$r1.union');
-#eval_dies_ok('$r1.subtracts');
-#
-#my $r2 = Foo.new(start => 51,
-# end => 100);
-#
-#is($r2.start, 51);
-#is($r2.end, 100);
-#is($r2.strand, 0); # defaults to 0
-#is($r2.length, 50);
-#
-##eval_dies_ok('my $dead = Foo.new(start => 100, end => 1)', 'dies if end <= start');
-##eval_dies_ok('my $dead = Foo.new(start => 1, end => 100, strand => 3)', 'dies if strand not 1, -1, 0');
-#
-##my $r1 = Foo.new(start => 1,
-## end => 100,
-## strand => 3);
View
0 t/Range.t 100755 → 100644
No changes.

0 comments on commit bef72fa

Please sign in to comment.