-
Notifications
You must be signed in to change notification settings - Fork 7
/
Copy pathtest_fasta_seq.pl
118 lines (92 loc) · 4.26 KB
/
test_fasta_seq.pl
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
require_ok("fasta_seq");
my $ralph=new_ok("fasta_seq",[ID=>"ralph",seq=> "ralph"]);
my $hubert=new_ok("fasta_seq",[ID=>"ralph",seq=>"ralph",desc=>"ralph3"]);
my $norbert=new_ok("fasta_seq",[ID=>"norbert",species=>"robot",seq=>"ralph"]);
## test if the program dies if the ID contains white characters
# add each white character at the beginning, in the middle or at the
# end of the ID
my $id_fails_tester=new_ok("fasta_seq",[ID=>"ralph",seq=> "ralph"]);
foreach my $white_to_test (sort ("\n", " ", "\r", "\f", "\t"))
{
my $id = $white_to_test."willi";
eval { $id_fails_tester->ID($id) };
like($@, qr/Non valid ID/, sprintf("ID format test for %#04x at start", ord($white_to_test)));
$id = "wil".$white_to_test."li";
eval { $id_fails_tester->ID($id) };
like($@, qr/Non valid ID/, sprintf("ID format test for %#04x in middle", ord($white_to_test)));
$id = "willi".$white_to_test;
eval { $id_fails_tester->ID($id) };
like($@, qr/Non valid ID/, sprintf("ID format test for %#04x at end", ord($white_to_test)));
}
## test if the program dies if the sequence contains white characters or digits
# add each white character at the beginning, in the middle or at the
# end of the sequence
my $seq_fails_tester=new_ok("fasta_seq",[ID=>"ralph",seq=> "ralph"]);
foreach my $char_to_test (sort ("\n", " ", "\r", "\f", "\t", "0".."9"))
{
my $seq = $char_to_test."willi";
eval { $seq_fails_tester->seq($seq) };
like($@, qr/Non valid sequence/, sprintf("Sequence format test for %#04x at start", ord($char_to_test)));
$seq = "wil".$char_to_test."li";
eval { $seq_fails_tester->seq($seq) };
like($@, qr/Non valid sequence/, sprintf("Sequence format test for %#04x in middle", ord($char_to_test)));
$seq = "willi".$char_to_test;
eval { $seq_fails_tester->seq($seq) };
like($@, qr/Non valid sequence/, sprintf("Sequence format test for %#04x at end", ord($char_to_test)));
}
## test if the program dies if the species contains line breaks
# add a newline at the beginning, in the middle or at the end of the
# species
my $species_fails_tester=new_ok("fasta_seq",[ID=>"ralph",seq=> "ralph"]);
my $char_to_test="\n";
my $spec = $char_to_test."willi";
eval { $species_fails_tester->species($spec) };
like($@, qr/Non valid species/, sprintf("Species format test for %#04x at start", ord($char_to_test)));
$spec = "wil".$char_to_test."li";
eval { $species_fails_tester->species($spec) };
like($@, qr/Non valid species/, sprintf("Species format test for %#04x in middle", ord($char_to_test)));
$spec = "willi".$char_to_test;
eval { $species_fails_tester->species($spec) };
like($@, qr/Non valid species/, sprintf("Species format test for %#04x at end", ord($char_to_test)));
## test if the program dies if the species contains line breaks
# add a newline at the beginning, in the middle or at the end of the
# description
my $description_fails_tester=new_ok("fasta_seq",[ID=>"ralph",seq=> "ralph"]);
$char_to_test="\n";
my $desc = $char_to_test."willi";
eval { $description_fails_tester->desc($desc) };
like($@, qr/Non valid description/, sprintf("Description format test for %#04x at start", ord($char_to_test)));
$desc = "wil".$char_to_test."li";
eval { $description_fails_tester->desc($desc) };
like($@, qr/Non valid description/, sprintf("Description format test for %#04x in middle", ord($char_to_test)));
$desc = "willi".$char_to_test;
eval { $description_fails_tester->desc($desc) };
like($@, qr/Non valid description/, sprintf("Description format test for %#04x at end", ord($char_to_test)));
#ID-Stuff
can_ok("fasta_seq","ID");
is($ralph->ID,"ralph","get_ID");
$ralph->ID("willi");
is($ralph->ID,"willi","set_ID");
can_ok("fasta_seq", "species");
is($ralph->species,undef,"get_species");
is($norbert->species,"robot","get_norbert_species");
$ralph->species("human");
is($ralph->species,"human","set_species");
can_ok("fasta_seq", "as_fasta");
is($ralph->as_fasta,">willi human\nralph\n","as_fasta");
#Seq-Stuff
can_ok("fasta_seq","seq");
is($ralph->seq,"ralph","get_seq");
$ralph->seq("willi");
is($ralph->seq,"willi","set_seq");
#desc-Stuff
can_ok("fasta_seq","desc");
is($ralph->desc, undef,"get_desc");
is($hubert->desc, "ralph3","get_desc");
$ralph->desc("willi");
is($ralph->desc,"willi","set_desc");
done_testing();