← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to t/primaryqual.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/primaryqual.t
1
1
# -*-Perl-*-
2
2
## Bioperl Test Harness Script for Modules
3
 
## $Id: primaryqual.t,v 1.12 2002/12/19 22:10:34 matsallac Exp $
 
3
## $Id: primaryqual.t,v 1.15 2005/07/13 12:29:17 heikki Exp $
4
4
#
5
5
# modeled after the t/Allele.t test script
6
6
 
17
17
        use lib 't';
18
18
    }
19
19
    use Test;
20
 
    plan tests => 31;
 
20
    plan tests => 32;
21
21
}
22
22
 
23
 
END { 
24
 
    unlink qw(batch_write_qual.qual write_qual.qual);
25
 
        
 
23
END {
 
24
        unlink qw(batch_write_qual.qual write_qual.qual);
26
25
}
27
26
# redirect STDERR to STDOUT
28
27
open (STDERR, ">&STDOUT");
29
28
use Bio::Root::IO;
30
29
use Bio::SeqIO;
31
 
use Bio::Seq::SeqWithQuality;
 
30
use Bio::Seq::Quality;
32
31
use Bio::Seq::PrimaryQual;
33
32
 
34
33
my $string_quals = "10 20 30 40 50 40 30 20 10";
35
 
print("Quals are $string_quals\n") if($DEBUG); 
36
 
my $qualobj = Bio::Seq::PrimaryQual->new( '-qual' => $string_quals,
 
34
print("Quals are $string_quals\n") if($DEBUG);
 
35
my $qualobj = Bio::Seq::PrimaryQual->new(
 
36
                                          '-qual' => $string_quals,
37
37
                                          '-id'  => 'QualityFragment-12',
38
38
                                          '-accession_number' => 'X78121',
39
39
                                          );
44
44
my @q2 = split/ /,$string_quals;
45
45
$qualobj = Bio::Seq::PrimaryQual->new
46
46
    ( '-qual'             => \@q2,
47
 
      '-primary_id'       =>    'chads primary_id',                     
48
 
      '-desc'             =>    'chads desc',
 
47
      '-primary_id'          => 'chads primary_id',
 
48
      '-desc'                   => 'chads desc',
49
49
      '-accession_number' => 'chads accession_number',
50
 
      '-id'               =>    'chads id'
 
50
      '-id'                        => 'chads id',
 
51
                '-header'           => 'chads header'
51
52
      );
52
53
 
53
54
ok($qualobj->primary_id, 'chads primary_id');
78
79
eval { $qualobj->qual(" 4"); };
79
80
ok(!$@);
80
81
 
 
82
$qualobj->qual("4 10");
 
83
 
81
84
ok($qualobj->length(),2 );
 
85
 
82
86
$qualobj->qual("10 20 30 40 50 40 30 20 10");
83
87
my @subquals = @{$qualobj->subqual(3,6);};
84
88
ok(@subquals, 4);
86
90
ok ("30 20 10" eq join(' ',@{$qualobj->subqual(7,9)}));
87
91
 
88
92
 
89
 
 
90
93
my @false_comparator = qw(30 40 70 40);
91
94
my @true_comparator = qw(30 40 50 40);
92
95
ok(!&compare_arrays(\@subquals,\@true_comparator));
117
120
ok($qualobj->desc(), "chads new desc");
118
121
ok($qualobj->display_id(), "chads new display_id");
119
122
$qualobj->display_id("chads new id");
120
 
ok($qualobj->display_id(), "chads new id"); 
121
 
 
122
 
my $in_qual  = Bio::SeqIO->new(-file => "<" . Bio::Root::IO->catfile("t","data","qualfile.qual") , 
 
123
ok($qualobj->display_id(), "chads new id");
 
124
 
 
125
ok($qualobj->header(), "chads header");
 
126
 
 
127
my $in_qual  = Bio::SeqIO->new(-file => "<" . 
 
128
                                        Bio::Root::IO->catfile("t","data","qualfile.qual") ,
123
129
                               '-format' => 'qual',
124
130
                               '-verbose' => $verbose);
125
131
ok($in_qual);
128
134
ok($pq->qual()->[100], '39'); # spot check boundary
129
135
 
130
136
my $out_qual = Bio::SeqIO->new('-file'    => ">write_qual.qual",
131
 
                               '-format'  => 'qual',
132
 
                               '-verbose' => $verbose);
 
137
                               '-format'  => 'qual',
 
138
                               '-verbose' => $verbose);
133
139
$out_qual->write_seq(-source    =>      $pq);
134
140
 
135
 
my $swq545 = Bio::Seq::SeqWithQuality->new (    -seq    =>      "ATA",
136
 
                                                -qual   =>      $pq
137
 
                                        );
 
141
my $swq545 = Bio::Seq::Quality->new (   -seq    =>      "ATA",
 
142
                                        -qual   =>      $pq
 
143
                                    );
138
144
$out_qual->write_seq(-source    =>      $swq545);
139
145
 
140
 
 
141
 
 
142
 
$in_qual = Bio::SeqIO->new('-file' => Bio::Root::IO->catfile("t","data","qualfile.qual") , 
 
146
$in_qual = Bio::SeqIO->new('-file' => 
 
147
                          Bio::Root::IO->catfile("t","data","qualfile.qual") , 
143
148
                           '-format' => 'qual',
144
149
                           '-verbose' => $verbose);
145
150
 
146
 
my $out_qual2 = Bio::SeqIO->new('-file'    => ">batch_write_qual.qual",
 
151
my $out_qual2 = Bio::SeqIO->new('-file' => ">batch_write_qual.qual",
147
152
                                '-format'  => 'qual',
148
153
                                '-verbose' => $verbose);
149
154
 
167
172
# dumpValue($qualobj);
168
173
 
169
174
sub compare_arrays {
170
 
    my ($a1,$a2) = @_;
171
 
    return 1 if (scalar(@{$a1}) != scalar(@{$a2}));
172
 
    my ($v1,$v2,$diff,$curr);
173
 
    for ($curr=0;$curr<scalar(@{$a1});$curr++){
174
 
        return 1 if ($a1->[$curr] ne $a2->[$curr]);
175
 
    }
176
 
    return 0;
 
175
        my ($a1,$a2) = @_;
 
176
        return 1 if (scalar(@{$a1}) != scalar(@{$a2}));
 
177
        my ($v1,$v2,$diff,$curr);
 
178
        for ($curr=0;$curr<scalar(@{$a1});$curr++){
 
179
                return 1 if ($a1->[$curr] ne $a2->[$curr]);
 
180
        }
 
181
        return 0;
177
182
}