File: WABA.t

package info (click to toggle)
bioperl 1.4-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k, sarge
  • size: 20,336 kB
  • ctags: 8,476
  • sloc: perl: 119,890; xml: 6,001; lisp: 121; makefile: 57
file content (84 lines) | stat: -rw-r--r-- 2,469 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
# -*-Perl-*-
## Bioperl Test Harness Script for Modules
## $Id: WABA.t,v 1.3 2002/09/16 22:13:31 jason Exp $

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.t'

my $error;

use strict;
use lib '.';

BEGIN {     
    # to handle systems with no installed Test module
    # we include the t dir (where a copy of Test.pm is located)
    # as a fallback
    eval { require Test; };
    if( $@ ) {
	use lib 't';
    }
    use vars qw($NTESTS);
    $NTESTS = 62;
    $error = 0;

    use Test;
    plan tests => $NTESTS; 
}

if( $error == 1 ) {
    exit(0);
}

use Bio::SearchIO;
use Bio::Root::IO;

my $wabain = new Bio::SearchIO(-format => 'waba',
			       -file   => Bio::Root::IO->catfile('t','data',
								 'test.waba'));

# These won't look the same as the WABA file because Jim's code is 0 based
# while we (bioperl) are 1 based.
my @results = ( 
		[ 'U57623', 'pair1_hs.fa', 'pair1_mm.fa',
		  [ 'U02884', 3, 
		    [qw(3833 34 2972 1 243 3688 1 40.9)],
		    [qw(4211 3022 6914 1 3705 6848 1 43.7)],
		    [qw(2218 7004 9171 1 6892 8712 1 50.3)],
		    ], 
		  ],
		[ 'X57152', 'pair9_hs.fa', 'pair9_mm.fa',
		  [ 'X80685', 1, 
		    [qw(7572 4 5845 1 632 7368 1 46.8)],
		    ], 
		  ]
		);
while( my $wabar = $wabain->next_result )  {
    my @r = @{shift @results};
    ok($wabar->query_name, shift @r);
    ok($wabar->query_database, shift @r);
    ok($wabar->database_name, shift @r);
    while( my $wabah = $wabar->next_hit ) {
	my (@h) = @{shift @r};
	ok( $wabah->name, shift @h);
	ok( $wabah->hsps(), shift @h);
	while( my $wabahsp = $wabah->next_hsp  ) {
	    my ( @hsp) = @{shift @h};
	    ok($wabahsp->length('total'), shift @hsp);
	    ok($wabahsp->query->start, shift @hsp);
	    ok($wabahsp->query->end, shift @hsp);
	    ok($wabahsp->strand('query'), shift @hsp);
	    ok($wabahsp->start('hit'), shift @hsp);
	    ok($wabahsp->end('subject'), shift @hsp);
	    ok($wabahsp->subject->strand, shift @hsp);
	    ok(length($wabahsp->query_string), $wabahsp->length('total'));
	    ok(length($wabahsp->hit_string), $wabahsp->length('total'));
	    ok(length($wabahsp->hmmstate_string), $wabahsp->length('total'));
	    my $hs = $wabahsp->hit_string;
	    ok($wabahsp->gaps('hit'), $hs  =~ tr/\-//);
	    my $qs = $wabahsp->query_string;
	    ok($wabahsp->gaps('query'),  $qs =~ tr/\-//);
	    ok(sprintf("%.1f",$wabahsp->percent_identity),shift @hsp);
	}
    }
}