← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to t/SeqIO/msout.t

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/SeqIO/msout.t
1
1
#!/usr/bin/perl
2
2
use version;
3
 
our $API_VERSION = qv('1.1.6');
4
 
 
 
3
our $API_VERSION = $Bio::SeqIO::msout::API_VERSION;
5
4
use strict;
6
5
use File::Path qw(mkpath rmtree);
7
6
 
10
9
    use Bio::Root::Test;
11
10
 
12
11
    test_begin(
13
 
        -tests               => 85,
 
12
        -tests               => 165,
14
13
        -requires_modules    => [q(Bio::SeqIO::msout)],
15
14
        -requires_networking => 0
16
15
    );
21
20
 
22
21
# skip tests if the msout.pm module is too old.
23
22
my $api_version = $Bio::SeqIO::msout::API_VERSION;
24
 
cmp_ok( $api_version,
25
 
    '>=', qv('1.1.5'), "Bio::SeqIO::msout is at least api version 1.1.5" );
 
23
cmp_ok( $api_version, '>=', qv('1.1.5'),
 
24
    "Bio::SeqIO::msout is at least api version 1.1.5" );
26
25
 
27
 
test_file_1( 0, "msout/msout_infile1" );
28
 
test_file_2( 0, "msout/msout_infile2" );
29
 
test_file_3( 0, "msout/msout_infile3" );
 
26
test_file_1( 0, "msout/msout_infile1" );    # 23 tests
 
27
test_file_2( 0, "msout/msout_infile2" );    # 22 tests
 
28
test_file_3( 0, "msout/msout_infile3" );    # 17 tests
30
29
 
31
30
# tests to run for api versions >= 1.1.6
32
31
SKIP: {
33
 
    skip q($Bio::SeqIO::msout::API_VERSION < 1.1.6) , 22 unless $api_version >= qv('1.1.6');
34
 
    test_file_4( 0, q(msout/msout_infile4) );
 
32
    skip q($Bio::SeqIO::msout::API_VERSION < 1.1.6), 22
 
33
      unless $api_version >= qv('1.1.6');
 
34
    test_file_1( 0, q(msout/msout_infile4) );
 
35
}
 
36
 
 
37
# tests to run for api versions >= 1.1.7
 
38
SKIP: {
 
39
    skip q($Bio::SeqIO::msout::API_VERSION < 1.1.7), 4
 
40
      unless $api_version >= qv('1.1.7');
 
41
    bad_test_file_1( 0, q(msout/bad_msout_infile1) ); # 2 tests
 
42
    bad_test_file_2( 0, q(msout/bad_msout_infile2) ); # 2 tests
 
43
}
 
44
 
 
45
# tests to run for api version >= 1.1.8
 
46
SKIP: {
 
47
    skip q($Bio::SeqIO::msout::API_VERSION < 1.1.8), 75
 
48
      unless $api_version >= qv('1.1.8');
 
49
 
 
50
    test_file_1( 0, "msout/msout_infile1", 100 );
 
51
    test_file_2( 0, "msout/msout_infile2", 10 );
 
52
    test_file_1( 0, q(msout/msout_infile4), 100 );
 
53
    bad_test_file_1( 0, q(msout/bad_msout_infile1), 1000 );
 
54
    bad_test_file_2( 0, q(msout/bad_msout_infile2), 1000 );
 
55
    bad_n_sites( 0, q(msout/msout_infile1) ); # 2 tests
35
56
}
36
57
 
37
58
sub create_dir {
38
59
 
39
60
    my $dir = shift;
40
61
 
41
 
    $dir = test_input_file($dir);
 
62
    $dir = Bio::Root::Test::test_input_file($dir);
42
63
 
43
64
    unless ( -d $dir ) {
44
65
        mkpath($dir);
49
70
 
50
71
    my $dir = shift;
51
72
 
52
 
    $dir = test_input_file($dir);
 
73
    $dir = Bio::Root::Test::test_input_file($dir);
53
74
 
54
75
    if ( -d $dir ) {
55
76
        rmtree($dir);
62
83
## Test file 1
63
84
##############################################################################
64
85
 
65
 
    my $gzip   = shift;
66
 
    my $infile = shift;
67
 
    $infile = test_input_file($infile);
 
86
    my $gzip    = shift;
 
87
    my $infile  = shift;
 
88
    my $n_sites = shift;
 
89
    $infile = Bio::Root::Test::test_input_file($infile);
68
90
 
69
 
    #print_file1( $infile, $gzip );
 
91
    # the files are now part of the git repo and don't have to be printed
 
92
    #    print_file1( $infile, $gzip );
70
93
 
71
94
    my $file_sequence = $infile;
72
95
    if ($gzip) {
73
 
        $file_sequence = "gunzip -c <$file_sequence |";
 
96
        $file_sequence = "gzip -dc <$file_sequence |";
74
97
    }
75
98
    my $msout = Bio::SeqIO->new(
76
 
        -file   => "$file_sequence",
77
 
        -format => 'msout',
 
99
        -file    => "$file_sequence",
 
100
        -format  => 'msout',
 
101
        -n_sites => $n_sites,
78
102
    );
79
103
 
80
104
    isa_ok( $msout, 'Bio::SeqIO::msout' );
82
106
    my $rh_base_conversion_table = $msout->get_base_conversion_table;
83
107
 
84
108
    my %attributes = (
85
 
        RUNS              => 3,
86
 
        SEGSITES          => 7,
87
 
        SEEDS             => [qw(1 1 1)],
88
 
        MS_INFO_LINE      => 'ms 6 3 -s 7 -I 3 3 2 1',
89
 
        TOT_RUN_HAPS      => 6,
90
 
        POPS              => [qw(3 2 1)],
91
 
        NEXT_RUN_NUM      => 1,
92
 
        LAST_READ_HAP_NUM => 0,
93
 
        POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
 
109
        RUNS                 => 3,
 
110
        SEGSITES             => 7,
 
111
        N_SITES              => $n_sites,
 
112
        SEEDS                => [qw(1 1 1)],
 
113
        MS_INFO_LINE         => 'ms 6 3 -s 7 -I 3 3 2 1',
 
114
        TOT_RUN_HAPS         => 6,
 
115
        POPS                 => [qw(3 2 1)],
 
116
        NEXT_RUN_NUM         => 1,
 
117
        LAST_READ_HAP_NUM    => 0,
 
118
        POSITIONS            => [qw(0.01 0.25 0.31 0.35 0.68 0.76 0.85)],
94
119
        CURRENT_RUN_SEGSITES => 7
95
120
    );
96
121
 
123
148
    # Testing next_hap at beginning of run
124
149
    my @data_got =
125
150
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
126
 
    my @data_expected = qw(1111111);
 
151
    my @data_expected;
 
152
    if ( !defined($n_sites) ) {
 
153
        @data_expected = qw(1111111);
 
154
    }
 
155
    else {
 
156
        @data_expected =
 
157
          qw(1000000000000000000000001000001000100000000000000000000000000000000100000001000000001000000000000000);
 
158
    }
127
159
    is_deeply( \@data_got, \@data_expected,
128
160
        "Get next_hap at beginning of run" );
129
161
 
130
162
    # Testing next_hap after beginning of run
131
163
    @data_got =
132
164
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
133
 
    @data_expected = qw(5555555);
 
165
    if ( !defined($n_sites) ) {
 
166
        @data_expected = qw(5555555);
 
167
    }
 
168
    else {
 
169
        @data_expected =
 
170
          qw(5000000000000000000000005000005000500000000000000000000000000000000500000005000000005000000000000000);
 
171
    }
134
172
    is_deeply( \@data_got, \@data_expected,
135
173
        "Get next_hap after beginning of run" );
136
174
 
141
179
    # Testing next_pop after beginning of pop
142
180
    @data_got =
143
181
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
144
 
    @data_expected = qw(4444444);
 
182
    if ( !defined($n_sites) ) {
 
183
        @data_expected = qw(4444444);
 
184
    }
 
185
    else {
 
186
        @data_expected =
 
187
          qw(4000000000000000000000004000004000400000000000000000000000000000000400000004000000004000000000000000);
 
188
    }
145
189
    is_deeply( \@data_got, \@data_expected,
146
190
        "Get next_pop after beginning of pop" );
147
191
 
148
192
    # Testing next_pop at beginning of pop
149
193
    @data_got =
150
194
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
151
 
    @data_expected = qw(4444444 5555555);
 
195
    if ( !defined($n_sites) ) {
 
196
        @data_expected = qw(4444444 5555555);
 
197
    }
 
198
    else {
 
199
        @data_expected =
 
200
          qw(4000000000000000000000004000004000400000000000000000000000000000000400000004000000004000000000000000 5000000000000000000000005000005000500000000000000000000000000000000500000005000000005000000000000000);
 
201
    }
152
202
    is_deeply( \@data_got, \@data_expected,
153
203
        "Get next_pop at beginning of pop" );
154
204
 
155
205
    # Testing next_run after beginning of run
156
206
    @data_got =
157
207
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
158
 
    @data_expected = qw(4444444);
 
208
    if ( !defined($n_sites) ) {
 
209
        @data_expected = qw(4444444);
 
210
    }
 
211
    else {
 
212
        @data_expected =
 
213
          qw(4000000000000000000000004000004000400000000000000000000000000000000400000004000000004000000000000000);
 
214
    }
159
215
    is_deeply( \@data_got, \@data_expected,
160
216
        "Get next_run after beginning of run" );
161
217
 
162
218
    # Testing next_pop at beginning of run
163
219
    @data_got =
164
220
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
165
 
    @data_expected = qw(5555555 5555555 5555555);
 
221
    if ( !defined($n_sites) ) {
 
222
        @data_expected = qw(5555555 5555555 5555555);
 
223
    }
 
224
    else {
 
225
        @data_expected =
 
226
          qw(5000000000000000000000005000005000500000000000000000000000000000000500000005000000005000000000000000 5000000000000000000000005000005000500000000000000000000000000000000500000005000000005000000000000000 5000000000000000000000005000005000500000000000000000000000000000000500000005000000005000000000000000);
 
227
    }
166
228
    is_deeply( \@data_got, \@data_expected,
167
229
        "Get next_pop at beginning of run" );
168
230
 
174
236
    # Testing next_run after pop and hap
175
237
    @data_got =
176
238
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
177
 
    @data_expected = qw(1111111 1515151);
 
239
    if ( !defined($n_sites) ) {
 
240
        @data_expected = qw(1111111 1515151);
 
241
    }
 
242
    else {
 
243
        @data_expected =
 
244
          qw(1000000000000000000000001000001000100000000000000000000000000000000100000001000000001000000000000000 1000000000000000000000005000001000500000000000000000000000000000000100000005000000001000000000000000);
 
245
    }
178
246
    is_deeply( \@data_got, \@data_expected, "Get next_run after pop and hap" );
179
247
 
180
248
    # Testing next_run at beginning of run
181
249
    @data_got =
182
250
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
183
 
    @data_expected = qw(
184
 
      1414141
185
 
      1414141
186
 
      1515151
187
 
      1414141
188
 
      1515151
189
 
      1515151);
 
251
    if ( !defined($n_sites) ) {
 
252
        @data_expected = qw(1414141 1414141 1515151 1414141 1515151 1515151);
 
253
    }
 
254
    else {
 
255
        @data_expected =
 
256
          qw(1000000000000000000000004000001000400000000000000000000000000000000100000004000000001000000000000000 1000000000000000000000004000001000400000000000000000000000000000000100000004000000001000000000000000 1000000000000000000000005000001000500000000000000000000000000000000100000005000000001000000000000000 1000000000000000000000004000001000400000000000000000000000000000000100000004000000001000000000000000 1000000000000000000000005000001000500000000000000000000000000000000100000005000000001000000000000000 1000000000000000000000005000001000500000000000000000000000000000000100000005000000001000000000000000);
 
257
    }
190
258
    is_deeply( \@data_got, \@data_expected,
191
259
        "Get next_run at beginning of run" );
192
260
 
198
266
## Test file 2
199
267
##############################################################################
200
268
 
201
 
    my $gzip   = shift;
202
 
    my $infile = shift;
203
 
    $infile = test_input_file($infile);
 
269
    my $gzip    = shift;
 
270
    my $infile  = shift;
 
271
    my $n_sites = shift;
 
272
    $infile = Bio::Root::Test::test_input_file($infile);
204
273
 
205
 
    #print_file2( $infile, $gzip );
 
274
    # the files are now part of the git repo and don't have to be printed
 
275
    #    print_file2( $infile, $gzip );
206
276
 
207
277
    my $file_sequence = $infile;
208
278
    if ($gzip) {
209
 
        $file_sequence = "gunzip -c <$file_sequence |";
 
279
        $file_sequence = "gzip -dc <$file_sequence |";
210
280
    }
211
281
 
212
282
    my $msout = Bio::SeqIO->new(
213
 
        -file   => "$file_sequence",
214
 
        -format => 'msout',
 
283
        -file    => "$file_sequence",
 
284
        -format  => 'msout',
 
285
        -n_sites => $n_sites,
215
286
    );
216
287
 
217
288
    isa_ok( $msout, 'Bio::SeqIO::msout' );
218
289
 
219
290
    my %attributes = (
220
 
        RUNS              => 3,
221
 
        SEGSITES          => 7,
222
 
        SEEDS             => [qw(1 1 1)],
223
 
        MS_INFO_LINE      => 'ms 6 3',
224
 
        TOT_RUN_HAPS      => 6,
225
 
        POPS              => 6,
226
 
        NEXT_RUN_NUM      => 1,
227
 
        LAST_READ_HAP_NUM => 0,
228
 
        POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
 
291
        RUNS                 => 3,
 
292
        SEGSITES             => 7,
 
293
        N_SITES              => $n_sites,
 
294
        SEEDS                => [qw(1 1 1)],
 
295
        MS_INFO_LINE         => 'ms 6 3',
 
296
        TOT_RUN_HAPS         => 6,
 
297
        POPS                 => 6,
 
298
        NEXT_RUN_NUM         => 1,
 
299
        LAST_READ_HAP_NUM    => 0,
 
300
        POSITIONS            => [qw(0.01 0.25 0.31 0.35 0.68 0.76 0.85)],
229
301
        CURRENT_RUN_SEGSITES => 7
230
302
    );
231
303
 
266
338
    # Testing next_hap after beginning of run
267
339
    @data_got =
268
340
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
269
 
    @data_expected = '5555555';
 
341
    if ( !defined($n_sites) ) {
 
342
        @data_expected = '5555555';
 
343
    }
 
344
    else {
 
345
        @data_expected = '5555055500';
 
346
    }
270
347
    is_deeply( \@data_got, \@data_expected,
271
348
        "Get next_hap after beginning of run" );
272
349
 
277
354
    # Testing next_pop after beginning of pop
278
355
    @data_got =
279
356
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
280
 
    @data_expected = qw(
281
 
      4444444
282
 
      4444444
283
 
      5555555
284
 
      4444444);
 
357
    if ( !defined($n_sites) ) {
 
358
        @data_expected = qw(4444444 4444444 5555555 4444444);
 
359
    }
 
360
    else {
 
361
        @data_expected = qw(4444044400 4444044400 5555055500 4444044400);
 
362
    }
285
363
    is_deeply( \@data_got, \@data_expected,
286
364
        "Get next_pop after beginning of pop" );
287
365
 
288
366
    # Testing next_pop at beginning of pop/run
289
367
    @data_got =
290
368
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
291
 
    @data_expected = qw(
292
 
      5555555
293
 
      5555555
294
 
      5555555
295
 
      1010101
296
 
      1111111
297
 
      1515151);
 
369
    if ( !defined($n_sites) ) {
 
370
        @data_expected = qw(5555555 5555555 5555555 1010101 1111111 1515151);
 
371
    }
 
372
    else {
 
373
        @data_expected =
 
374
          qw(5555055500 5555055500 5555055500 1010010100 1111011100 1515015100);
 
375
    }
298
376
    is_deeply( \@data_got, \@data_expected,
299
377
        "Get next_pop at beginning of pop/run" );
300
378
 
301
379
    # Testing next_run at beginning of run
302
380
    @data_got =
303
381
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
304
 
    @data_expected = qw(
305
 
      1414141
306
 
      1414141
307
 
      1515151
308
 
      1414141
309
 
      1515151
310
 
      1515151);
 
382
    if ( !defined($n_sites) ) {
 
383
        @data_expected = qw(1414141 1414141 1515151 1414141 1515151 1515151);
 
384
    }
 
385
    else {
 
386
        @data_expected =
 
387
          qw(1414014100 1414014100 1515015100 1414014100 1515015100 1515015100);
 
388
    }
311
389
    is_deeply( \@data_got, \@data_expected,
312
390
        "Get next_run at beginning of run" );
313
391
 
314
392
    # Testing next_hap at beginning of run 2
315
393
    @data_got =
316
394
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
317
 
    @data_expected = '1515151';
 
395
    if ( !defined($n_sites) ) {
 
396
        @data_expected = '1515151';
 
397
    }
 
398
    else {
 
399
        @data_expected = '1515015100';
 
400
    }
318
401
    is_deeply( \@data_got, \@data_expected,
319
402
        "Get next_hap at beginning of run 2" );
320
403
 
321
404
    # Testing next_run after hap
322
405
    @data_got =
323
406
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
324
 
    @data_expected = qw(
325
 
      5050505
326
 
      5151515
327
 
      5555555
328
 
      5454545
329
 
      5454545);
 
407
    if ( !defined($n_sites) ) {
 
408
        @data_expected = qw(5050505 5151515 5555555 5454545 5454545);
 
409
    }
 
410
    else {
 
411
        @data_expected =
 
412
          qw(5050050500 5151051500 5555055500 5454054500 5454054500);
 
413
    }
330
414
    is_deeply( \@data_got, \@data_expected, "Get next_run after hap" );
331
415
 
332
416
    is( $msout->get_next_run_num, 5, 'next run should be 5.' );
344
428
## Test file 3
345
429
##############################################################################
346
430
 
347
 
    my $gzip   = shift;
348
 
    my $infile = shift;
349
 
    $infile = test_input_file($infile);
 
431
    my $gzip    = shift;
 
432
    my $infile  = shift;
 
433
    $infile = Bio::Root::Test::test_input_file($infile);
350
434
 
351
 
    #print_file3( $infile, $gzip );
 
435
    # the files are now part of the git repo and don't have to be printed
 
436
    #    print_file3( $infile, $gzip );
352
437
 
353
438
    my $file_sequence = $infile;
354
439
    if ($gzip) {
355
 
        $file_sequence = "gunzip -c <$file_sequence |";
 
440
        $file_sequence = "gzip -dc <$file_sequence |";
356
441
    }
357
442
    my $msout = Bio::SeqIO->new(
358
443
        -file   => "$file_sequence",
363
448
 
364
449
    my $rh_base_conversion_table = $msout->get_base_conversion_table;
365
450
 
366
 
    isa_ok( $msout, 'Bio::SeqIO::msout' );
367
 
 
368
451
    my %attributes = (
369
 
        RUNS              => 1,
370
 
        SEGSITES          => 7,
371
 
        SEEDS             => [qw(1 1 1)],
372
 
        MS_INFO_LINE      => 'ms 3 1',
373
 
        TOT_RUN_HAPS      => 3,
374
 
        POPS              => 3,
375
 
        NEXT_RUN_NUM      => 1,
376
 
        LAST_READ_HAP_NUM => 0,
377
 
        POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
 
452
        RUNS                 => 1,
 
453
        SEGSITES             => 7,
 
454
        SEEDS                => [qw(1 1 1)],
 
455
        MS_INFO_LINE         => 'ms 3 1',
 
456
        TOT_RUN_HAPS         => 3,
 
457
        POPS                 => 3,
 
458
        NEXT_RUN_NUM         => 1,
 
459
        LAST_READ_HAP_NUM    => 0,
 
460
        POSITIONS            => [qw(0.01 0.25 0.31 0.35 0.68 0.76 0.85)],
378
461
        CURRENT_RUN_SEGSITES => 7
379
462
    );
380
463
 
434
517
 
435
518
}
436
519
 
437
 
sub test_file_4 {
438
 
##############################################################################
439
 
## Test file 4
440
 
##############################################################################
441
 
 
442
 
# All this does is test to see if Bio::SeqIO::msout can handle ms output files 
443
 
# with multiple newline characters randomly interspersed in the file.
444
 
 
445
 
    my $gzip   = shift;
446
 
    my $infile = shift;
447
 
    $infile = test_input_file($infile);
448
 
 
449
 
    #print_file4( $infile, $gzip );
450
 
 
451
 
    my $file_sequence = $infile;
452
 
    if ($gzip) {
453
 
        $file_sequence = "gunzip -c <$file_sequence |";
454
 
    }
455
 
    my $msout = Bio::SeqIO->new(
456
 
        -file   => "$file_sequence",
457
 
        -format => 'msout',
458
 
    );
459
 
 
460
 
    isa_ok( $msout, 'Bio::SeqIO::msout' );
461
 
 
462
 
    my $rh_base_conversion_table = $msout->get_base_conversion_table;
463
 
 
464
 
    my %attributes = (
465
 
        RUNS              => 3,
466
 
        SEGSITES          => 7,
467
 
        SEEDS             => [qw(1 1 1)],
468
 
        MS_INFO_LINE      => 'ms 6 3 -s 7 -I 3 3 2 1',
469
 
        TOT_RUN_HAPS      => 6,
470
 
        POPS              => [qw(3 2 1)],
471
 
        NEXT_RUN_NUM      => 1,
472
 
        LAST_READ_HAP_NUM => 0,
473
 
        POSITIONS => [qw(79.1001 80.1001 81.101 82.101 83.10001 84.801 85)],
474
 
        CURRENT_RUN_SEGSITES => 7
475
 
    );
476
 
 
477
 
    foreach my $attribute ( keys %attributes ) {
478
 
        my $func = lc($attribute);
479
 
 
480
 
        if ( $attribute =~ m/POPS|SEEDS|POSITIONS/ ) {
481
 
            $func = ucfirst($func);
482
 
        }
483
 
 
484
 
        $func = 'get_' . $func;
485
 
        my @returns = $msout->$func();
486
 
        my ( $return, $got );
487
 
 
488
 
        # If there were more than one return value, then compare references to
489
 
        # arrays instead of scalars
490
 
        unless ( @returns > 1 ) {
491
 
            $got = shift @returns;
492
 
        }
493
 
        else { $got = \@returns }
494
 
 
495
 
        my $expected = $attributes{$attribute};
496
 
 
497
 
        if ( defined $got && defined $expected ) {
498
 
            is_deeply( $got, $expected, "Get $attribute" );
499
 
        }
500
 
        else { is_deeply( $got, $expected, "Get $attribute" ) }
501
 
    }
502
 
 
503
 
    # Testing next_hap at beginning of run
504
 
    my @data_got =
505
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
506
 
    my @data_expected = qw(1111111);
507
 
    is_deeply( \@data_got, \@data_expected,
508
 
        "Get next_hap at beginning of run" );
509
 
 
510
 
    # Testing next_hap after beginning of run
511
 
    @data_got =
512
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_seq );
513
 
    @data_expected = qw(5555555);
514
 
    is_deeply( \@data_got, \@data_expected,
515
 
        "Get next_hap after beginning of run" );
516
 
 
517
 
    # Surprise test! testing msout::outgroup
518
 
    my $outgroup = $msout->outgroup;
519
 
    is( $outgroup, 1, "Testing msout::outgroup" );
520
 
 
521
 
    # Testing next_pop after beginning of pop
522
 
    @data_got =
523
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
524
 
    @data_expected = qw(4444444);
525
 
    is_deeply( \@data_got, \@data_expected,
526
 
        "Get next_pop after beginning of pop" );
527
 
 
528
 
    # Testing next_pop at beginning of pop
529
 
    @data_got =
530
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
531
 
    @data_expected = qw(4444444 5555555);
532
 
    is_deeply( \@data_got, \@data_expected,
533
 
        "Get next_pop at beginning of pop" );
534
 
 
535
 
    # Testing next_run after beginning of run
536
 
    @data_got =
537
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
538
 
    @data_expected = qw(4444444);
539
 
    is_deeply( \@data_got, \@data_expected,
540
 
        "Get next_run after beginning of run" );
541
 
 
542
 
    # Testing next_pop at beginning of run
543
 
    @data_got =
544
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_pop );
545
 
    @data_expected = qw(5555555 5555555 5555555);
546
 
    is_deeply( \@data_got, \@data_expected,
547
 
        "Get next_pop at beginning of run" );
548
 
 
549
 
    # Testing next_hap after pop
550
 
    @data_got      = $msout->get_next_hap;
551
 
    @data_expected = qw(1010101);
552
 
    is_deeply( \@data_got, \@data_expected, "Get next_hap after pop" );
553
 
 
554
 
    # Testing next_run after pop and hap
555
 
    @data_got =
556
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
557
 
    @data_expected = qw(1111111 1515151);
558
 
    is_deeply( \@data_got, \@data_expected, "Get next_run after pop and hap" );
559
 
 
560
 
    # Testing next_run at beginning of run
561
 
    @data_got =
562
 
      convert_bases_to_nums( $rh_base_conversion_table, $msout->get_next_run );
563
 
    @data_expected = qw(
564
 
      1414141
565
 
      1414141
566
 
      1515151
567
 
      1414141
568
 
      1515151
569
 
      1515151);
570
 
    is_deeply( \@data_got, \@data_expected,
571
 
        "Get next_run at beginning of run" );
572
 
 
573
 
    is( $msout->get_next_run_num, undef, 'have all lines been read?' );
574
 
}
575
 
 
576
 
sub print_file1 {
577
 
 
578
 
    my $destination = shift;
579
 
    my $gzip        = shift;
580
 
 
581
 
    my $out = <<END
582
 
ms 6 3 -s 7 -I 3 3 2 1
583
 
1 1 1
584
 
 
585
 
//
586
 
segsites: 7
587
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
588
 
1111111
589
 
5555555
590
 
4444444
591
 
4444444
592
 
5555555
593
 
4444444
594
 
//
595
 
segsites: 7
596
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
597
 
5555555
598
 
5555555
599
 
5555555
600
 
1010101
601
 
1111111
602
 
1515151
603
 
//
604
 
segsites: 7
605
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
606
 
1414141
607
 
1414141
608
 
1515151
609
 
1414141
610
 
1515151
611
 
1515151
612
 
END
613
 
      ;
614
 
 
615
 
    if ($gzip) {
616
 
        $gzip = "| gzip";
617
 
    }
618
 
    else { $gzip = ' '; }
619
 
    open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
620
 
 
621
 
    print OUT $out;
622
 
    close OUT;
623
 
}
624
 
 
625
 
sub print_file2 {
626
 
 
627
 
    my $destination = shift;
628
 
    my $gzip        = shift;
629
 
 
630
 
    my $out = <<END
631
 
ms 6 3
632
 
1 1 1
633
 
 
634
 
//
635
 
segsites: 7
636
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
637
 
1111111
638
 
5555555
639
 
4444444
640
 
4444444
641
 
5555555
642
 
4444444
643
 
//
644
 
segsites: 7
645
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
646
 
5555555
647
 
5555555
648
 
5555555
649
 
1010101
650
 
1111111
651
 
1515151
652
 
//
653
 
segsites: 7
654
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
655
 
1414141
656
 
1414141
657
 
1515151
658
 
1414141
659
 
1515151
660
 
1515151
661
 
//
662
 
segsites: 7
663
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
664
 
1515151
665
 
5050505
666
 
5151515
667
 
5555555
668
 
5454545
669
 
5454545
670
 
//
671
 
segsites: 7
672
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
673
 
5555555
674
 
END
675
 
      ;
676
 
 
677
 
    if ($gzip) {
678
 
        $gzip = "| gzip";
679
 
    }
680
 
    else { $gzip = ' '; }
681
 
 
682
 
    open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
683
 
 
684
 
    print OUT $out;
685
 
    close OUT;
686
 
}
687
 
 
688
 
sub print_file3 {
689
 
 
690
 
    my $destination = shift;
691
 
    my $gzip        = shift;
692
 
 
693
 
    my $out = <<END ;
694
 
ms 3 1
695
 
1 1 1
696
 
 
697
 
//
698
 
segsites: 7
699
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
700
 
1111111
701
 
5555555
702
 
4444444
703
 
END
704
 
 
705
 
    if ($gzip) {
706
 
        $gzip = "| gzip";
707
 
    }
708
 
    else { $gzip = ' '; }
709
 
 
710
 
    open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
711
 
 
712
 
    print OUT $out;
713
 
    close OUT;
714
 
}
715
 
 
716
 
sub print_file4 {
717
 
 
718
 
    my $destination = shift;
719
 
    my $gzip        = shift;
720
 
 
721
 
    my $out = <<END
722
 
 
723
 
 
724
 
 
725
 
 
726
 
ms 6 3 -s 7 -I 3 3 2 1
727
 
 
728
 
 
729
 
 
730
 
1 1 1
731
 
 
732
 
//
733
 
 
734
 
segsites: 7
735
 
 
736
 
 
737
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
738
 
 
739
 
 
740
 
1111111
741
 
5555555
742
 
 
743
 
 
744
 
4444444
745
 
 
746
 
4444444
747
 
5555555
748
 
 
749
 
4444444
750
 
 
751
 
 
752
 
//
753
 
 
754
 
segsites: 7
755
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
756
 
5555555
757
 
5555555
758
 
 
759
 
 
760
 
 
761
 
5555555
762
 
1010101
763
 
1111111
764
 
1515151
765
 
 
766
 
//
767
 
segsites: 7
768
 
 
769
 
 
770
 
 
771
 
positions: 79.1001 80.1001 81.101 82.101 83.10001 84.801 85
772
 
 
773
 
1414141
774
 
1414141
775
 
1515151
776
 
1414141
777
 
1515151
778
 
1515151
779
 
 
780
 
 
781
 
 
782
 
 
783
 
 
784
 
END
785
 
      ;
786
 
 
787
 
    if ($gzip) {
788
 
        $gzip = "| gzip";
789
 
    }
790
 
    else { $gzip = ' '; }
791
 
    open OUT, "$gzip >$destination" or die "Unable to open $destination\n";
792
 
 
793
 
    print OUT $out;
794
 
    close OUT;
795
 
}
796
 
 
797
 
 
798
520
sub print_to_file {
799
521
    my ( $ra_in, $out ) = @_;
800
522
    unless ( open OUT, ">$out" ) {
820
542
    return @out_seqstrings;
821
543
 
822
544
}
 
545
 
 
546
sub bad_test_file_1 {
 
547
##############################################################################
 
548
## Bad Test file 1
 
549
##############################################################################
 
550
 
 
551
    # This sub tests to see if msout.pm will catch if the msinfo line's
 
552
    # advertized haps are less than are actually in the file
 
553
 
 
554
    my $gzip    = shift;
 
555
    my $infile  = shift;
 
556
    my $n_sites = shift;
 
557
    $infile = test_input_file($infile);
 
558
 
 
559
    my $file_sequence = $infile;
 
560
    if ($gzip) {
 
561
        $file_sequence = "gunzip -c <$file_sequence |";
 
562
    }
 
563
    my $msout = Bio::SeqIO->new(
 
564
        -file    => "$file_sequence",
 
565
        -format  => 'msout',
 
566
        -n_sites => $n_sites,
 
567
    );
 
568
 
 
569
    isa_ok( $msout, 'Bio::SeqIO::msout' );
 
570
 
 
571
    throws_ok { $msout->get_next_run }
 
572
qr/msout file has only 2 hap\(s\), which is less than indicated in msinfo line \( 9 \)/,
 
573
      q(Caught error in bad msout file 1);
 
574
 
 
575
}
 
576
 
 
577
sub bad_test_file_2 {
 
578
##############################################################################
 
579
## Bad Test file 2
 
580
##############################################################################
 
581
 
 
582
    # This sub tests to see if msout.pm will catch if the msinfo line's
 
583
    # advertized haps are more than are actually in the file
 
584
 
 
585
    my $gzip    = shift;
 
586
    my $infile  = shift;
 
587
    my $n_sites = shift;
 
588
    $infile = test_input_file($infile);
 
589
 
 
590
    my $file_sequence = $infile;
 
591
    if ($gzip) {
 
592
        $file_sequence = "gunzip -c <$file_sequence |";
 
593
    }
 
594
    my $msout = Bio::SeqIO->new(
 
595
        -file    => "$file_sequence",
 
596
        -format  => 'msout',
 
597
        -n_sites => $n_sites,
 
598
    );
 
599
 
 
600
    isa_ok( $msout, 'Bio::SeqIO::msout' );
 
601
 
 
602
    throws_ok { $msout->get_next_run }
 
603
qr/\'\/\/\' not encountered when expected. There are more haplos in one of the msOUT runs than advertised in the msinfo line/,
 
604
      q(Caught error in bad msout file 2);
 
605
 
 
606
}
 
607
 
 
608
sub bad_n_sites {
 
609
##############################################################################
 
610
## Bad n_sites
 
611
##############################################################################
 
612
 
 
613
    # this sub tests if msout.pm dies when n_sites is smaller than segsites
 
614
    my $gzip    = shift;
 
615
    my $infile  = shift;
 
616
    $infile = Bio::Root::Test::test_input_file($infile);
 
617
 
 
618
    my $file_sequence = $infile;
 
619
    if ($gzip) {
 
620
        $file_sequence = "gzip -dc <$file_sequence |";
 
621
    }
 
622
    my $msout = Bio::SeqIO->new(
 
623
            -file    => "$file_sequence",
 
624
            -format  => 'msout',
 
625
    );
 
626
 
 
627
    # test nsites -1
 
628
    throws_ok { $msout->set_n_sites(-1) } qr|first argument needs to be a positive integer. argument supplied: -1|;
 
629
 
 
630
    # test nsites smaller than next hap
 
631
    $msout->set_n_sites(1);
 
632
    throws_ok{$msout->get_next_seq} qr/n_sites needs to be at least the number of segsites of every run/, 'too few n_sites failed OK';
 
633
    
 
634
}