1 # -*-Perl-*- Test Harness script for Bioperl
10 test_begin(-tests => 70);
13 use_ok('Bio::Seq::Quality');
14 use_ok('Bio::Seq::PrimaryQual');
17 my $DEBUG = test_debug();
18 my $verbose = -1 unless $DEBUG;
20 # redirect STDERR to STDOUT
21 open (STDERR, ">&STDOUT");
23 my $string_quals = "10 20 30 40 50 40 30 20 10";
24 print("Quals are $string_quals\n") if($DEBUG);
25 ok my $qualobj = Bio::Seq::PrimaryQual->new(
26 -qual => $string_quals,
27 -id => 'QualityFragment-12',
28 -accession_number => 'X78121',
30 is $qualobj->display_id, 'QualityFragment-12';
31 is $qualobj->accession_number, 'X78121';
33 my @q2 = split / /, $string_quals;
34 $qualobj = Bio::Seq::PrimaryQual->new(
36 -primary_id => 'chads primary_id',
37 -desc => 'chads desc',
38 -accession_number => 'chads accession_number',
40 -header => 'chads header'
43 is $qualobj->primary_id, 'chads primary_id';
44 isa_ok $qualobj->qual(), 'ARRAY';
46 my $newqualstring = "50 90 1000 20 12 0 0";
48 ok $qualobj->qual($newqualstring);
49 is join(' ', @{$qualobj->qual()}), $newqualstring;
51 my @newqualarray = split / /,$newqualstring;
52 ok $qualobj->qual(\@newqualarray);
53 is join(' ', @{$qualobj->qual()}), $newqualstring;
55 is $qualobj->validate_qual($string_quals ), 1;
56 is $qualobj->validate_qual("" ), 1;
57 is $qualobj->validate_qual("0" ), 1;
58 is $qualobj->validate_qual(undef ), 1;
59 is $qualobj->validate_qual(" " ), 1;
60 is $qualobj->validate_qual("10 20 30 30" ), 1;
61 is $qualobj->validate_qual(" 20 9 5 " ), 1;
62 is $qualobj->validate_qual("+1 9.3 50e-1"), 1;
63 is $qualobj->validate_qual(" 4" ), 1;
64 is $qualobj->validate_qual("chad" ), 0;
65 is $qualobj->validate_qual("10 one" ), 0;
67 ok $qualobj->qual("10 20 30 30");
68 ok $qualobj->qual("+1 9.3 50e-1");
69 throws_ok { $qualobj->qual("chad"); } qr/.+/;
70 throws_ok { $qualobj->validate_qual("chad", 1) } qr/.+/;
72 ok $qualobj->qual("4 10");
73 is $qualobj->length(), 2;
75 $qualobj->qual("10 20 30 40 50 40 30 20 10");
76 ok my @subquals = @{$qualobj->subqual(3,6);};
78 is "30 20 10", join(' ',@{$qualobj->subqual(7,9)});
80 throws_ok { $qualobj->subqual(-1,6); } qr/EX/;
81 ok $qualobj->subqual(1,6);
82 ok $qualobj->subqual(1,9);
83 throws_ok { $qualobj->subqual(9,1); } qr/EX/;
86 is $qualobj->display_id(), "chads id";
87 is $qualobj->display_id("chads new display_id"), "chads new display_id";
88 is $qualobj->display_id(), "chads new display_id";
90 is $qualobj->accession_number(), "chads accession_number";
91 is $qualobj->accession_number("chads new accession_number"), "chads new accession_number";
92 is $qualobj->accession_number(), "chads new accession_number";
93 is $qualobj->primary_id(), "chads primary_id";
94 is $qualobj->primary_id("chads new primary_id"), "chads new primary_id";
95 is $qualobj->primary_id(), "chads new primary_id";
97 is $qualobj->desc(), "chads desc";
98 is $qualobj->desc("chads new desc"), "chads new desc";
99 is $qualobj->desc(), "chads new desc";
100 is $qualobj->display_id(), "chads new display_id";
101 is $qualobj->display_id("chads new id"), ("chads new id");
102 is $qualobj->display_id(), "chads new id";
104 is $qualobj->header(), "chads header";
106 ok my $in_qual = Bio::SeqIO->new(
107 -file => test_input_file('qualfile.qual'),
109 -verbose => $verbose,
111 ok my $pq = $in_qual->next_seq();
112 is $pq->qual()->[99] , '39'; # spot check boundary
113 is $pq->qual()->[100], '39'; # spot check boundary
115 ok my $out_qual = Bio::SeqIO->new(
116 -file => ">".test_output_file(),
118 -verbose => $verbose,
120 ok $out_qual->write_seq(-source => $pq);
122 ok my $swq545 = Bio::Seq::Quality->new (
126 ok $out_qual->write_seq(-source => $swq545);
128 ok $in_qual = Bio::SeqIO->new(
129 -file => test_input_file('qualfile.qual'),
131 -verbose => $verbose,
134 ok my $out_qual2 = Bio::SeqIO->new(
135 -file => ">".test_output_file(),
137 -verbose => $verbose,
140 while ( my $batch_qual = $in_qual->next_seq() ) {
141 ok $out_qual2->write_seq(-source => $batch_qual);