1#!/usr/bin/env perl 2# 3# Author: petr.danecek@sanger 4# 5# Usage: test.t [-d] 6# 7 8use strict; 9use warnings; 10use Carp; 11use IPC::Open2; 12use FindBin; 13use lib "$FindBin::Bin"; 14use Vcf; 15 16BEGIN { 17 use Test::Most tests => 75; 18} 19 20 21my $path = $FindBin::RealBin; 22 23my $debug = ($ARGV[0] && $ARGV[0] eq '-d') ? 1 : 0; 24 25test_bgzip_and_tabix("$path/../examples/merge-test-a.vcf"); 26test_validator($path,"$path/../examples/valid-3.3.vcf"); 27test_validator($path,"$path/../examples/valid-4.0.vcf"); 28test_validator($path,"$path/../examples/valid-4.1.vcf"); 29test_validator($path,"$path/../examples/floats.vcf"); 30test_format_validation($path,'3.3'); 31test_format_validation($path,'4.0'); 32test_format_validation($path,'4.1'); 33test_parse($path); 34test_vcf_stats($path,"$path/../examples/valid-4.0.vcf"); 35test_empty_cols($path,'4.0'); 36test_merge($path,'merge-test.vcf.out','merge-test-a.vcf','merge-test-b.vcf','merge-test-c.vcf'); 37test_compare($path,'cmp-test-a.vcf','cmp-test-b.vcf','cmp-test.out'); 38test_isec($path,'-n +2','isec-n2-test.vcf.out','merge-test-a.vcf','merge-test-b.vcf','merge-test-c.vcf'); 39test_query_vcf("$path/../examples/",'cmp-test-a.vcf','query-test.out','%CHROM:%POS\tref=%REF\talt=%ALT\tqual=%QUAL\t%INFO/DP[\t%SAMPLE=%GT]\n'); 40test_shuffle("$path/../examples/",'cmp-test-a.vcf','shuffle-test.vcf'); 41test_concat("$path/../examples/",'concat.out','concat-a.vcf','concat-b.vcf','concat-c.vcf'); 42test_annotate("$path/../examples/",'-c FROM,TO,CHROM,-,-,-,INFO/HM2,INFO/GN,INFO/DP -d key=INFO,ID=HM2,Number=0,Type=Flag,Description="HapMap2 membership" -d key=INFO,ID=GN,Number=1,Type=String,Description="Gene Name" -d key=INFO,ID=DP,Number=0,Type=Integer,Description="Depth,etc"','annotate.out','concat-a.vcf','annotate.txt'); 43test_annotate("$path/../examples/",'-c FROM,TO,CHROM,ID,REF,ALT,INFO/HM2,INFO/GN,INFO/DP -d key=INFO,ID=HM2,Number=0,Type=Flag,Description="HapMap2 membership" -d key=INFO,ID=GN,Number=1,Type=String,Description="Gene Name" -d key=INFO,ID=DP,Number=0,Type=Integer,Description="Depth,etc"','annotate3.out','concat-a.vcf','annotate.txt'); 44test_annotate("$path/../examples/",'-f +/D=34/c=2,3','annotate2.out','annotate-test.vcf'); 45test_fill_an_ac("$path/../examples/",'fill-an-ac.out','concat-a.vcf'); 46test_indel_stats("$path/../examples/",'indel-stats.out','indel-stats.vcf','indel-stats.tab'); 47test_consensus("$path/../examples/",'','consensus.out','consensus.vcf','consensus.fa'); 48test_consensus("$path/../examples/",'-s NA001','consensus.out2','consensus.vcf','consensus.fa'); 49test_contrast("$path/../examples/",'-n +D -A,B,C -d 10','contrast.out','contrast.vcf'); 50test_ploidy("$path/../examples/",'fix-ploidy'); 51test_api_event_type([qw(A C),'s 1 C'],[qw(A ACGT),'i 3 CGT'],[qw(ACGT A),'i -3 CGT'],[qw(ACGT ACT),'i -1 G'], 52 [qw(ACGT AAA),'o 3 AAA'],[qw(A .),'r 0 A'],[qw(A <ID>),'u 0 <ID>'],[qw(ACG AGC),'s 2 AGC'], [qw(A .A),'b'], [qw(A A.),'b']); 53test_api(); 54 55exit; 56 57#-------------------------------------- 58 59sub test_bgzip_and_tabix 60{ 61 my ($file) = @_; 62 my $cmd; 63 64 $cmd = "cat $file | bgzip -c > $file.gz"; 65 system($cmd); 66 is($?,0,"Is bgzip OK? .. $cmd"); 67 68 $cmd = "tabix $file.gz"; 69 system($cmd); 70 is($?,0,"Is tabix OK? .. $cmd"); 71} 72 73sub test_validator 74{ 75 my ($path,$fname) = @_; 76 77 my $cmd = "perl -I$path -MVcf -e validate $fname"; 78 my @out = `$cmd 2>&1`; 79 my @exp = (); 80 is_deeply(\@out,\@exp,"Testing validator .. $cmd"); 81} 82 83sub test_format_validation 84{ 85 my ($path,$version) = @_; 86 87 my ($chld_in,$chld_out); 88 my $cmd = "perl -I$path -MVcf -e validate 2>&1"; 89 my $pid = open2($chld_out, $chld_in, $cmd); 90 91 my $vcf = Vcf->new(version=>$version); 92 $vcf->recalc_ac_an(2); 93 $vcf->add_header_line({key=>'INFO', ID=>'AC',Number=>-1,Type=>'Integer',Description=>'Allele count in genotypes'}); 94 $vcf->add_header_line({key=>'INFO', ID=>'AN',Number=>1,Type=>'Integer',Description=>'Total number of alleles in called genotypes'}); 95 $vcf->add_header_line({key=>'FORMAT', ID=>'GT',Number=>1,Type=>'String',Description=>'Genotype'}); 96 if ( $version >= 4.0 ) 97 { 98 $vcf->add_header_line({key=>'ALT',ID=>'DEL:ME:ALU', Description=>'Deletion of ALU element'}); 99 } 100 if ( $version >= 4.1 ) 101 { 102 $vcf->add_header_line({key=>'reference',value=>'file:/some/file.fa'}); 103 $vcf->add_header_line({key=>'contig',ID=>'1',length=>12345,md5=>'f126cdf8a6e0c7f379d618ff66beb2da',assembly=>'E.T.'}); 104 } 105 $vcf->add_columns('NA0001','NA0002'); 106 print $vcf->format_header() unless !$debug; 107 print $chld_in $vcf->format_header(); 108 109 my %rec = ( CHROM=>1, POS=>1, REF=>'A', QUAL=>$$vcf{defaults}{QUAL}, FORMAT=>['GT'] ); 110 $rec{gtypes}{NA0001}{GT} = 'A/A'; 111 $rec{gtypes}{NA0002}{GT} = $$vcf{defaults}{GT}; 112 $vcf->format_genotype_strings(\%rec); 113 print $vcf->format_line(\%rec) unless !$debug; 114 print $chld_in $vcf->format_line(\%rec); 115 116 $rec{POS} = 2; 117 $rec{gtypes}{NA0002}{GT} = 'IA|D1'; 118 if ( $version >= 4.0 ) 119 { 120 $rec{REF} = 'AC'; 121 $rec{gtypes}{NA0002}{GT} = 'ATC|<DEL:ME:ALU>'; 122 } 123 $vcf->format_genotype_strings(\%rec); 124 print $vcf->format_line(\%rec) unless !$debug; 125 print $chld_in $vcf->format_line(\%rec); 126 close($chld_in); 127 128 my @exp = (); 129 my @out = (); 130 while (my $line=<$chld_out>) 131 { 132 chomp($line); 133 push @out,$line; 134 } 135 close($chld_out); 136 waitpid $pid, 0; 137 138 if ( !is_deeply(\@out,\@exp,"Testing formatting followed by validation .. $cmd") ) 139 { 140 print STDERR @out; 141 } 142} 143 144sub test_parse 145{ 146 my ($path) = @_; 147 my $vcf = Vcf->new(file=>"$path/../examples/parse-test.vcf"); 148 $vcf->parse_header; 149 my $line; 150 $line = $vcf->next_data_array; is_deeply($$line[4],"G","Testing next_data_array"); 151 $line = $vcf->next_data_array; is_deeply($$line[4],"G,<DEL2>,T,<DEL3>","Testing next_data_array"); 152 $line = $vcf->next_data_array; is_deeply($$line[4],"<DEL1>,G,<DEL2>,T","Testing next_data_array"); 153 $line = $vcf->next_data_array; is_deeply($$line[4],"<DEL1>,G,<DEL2>,T,<DEL3>","Testing next_data_array"); 154} 155 156sub test_vcf_stats 157{ 158 my ($path,$file) = @_; 159 my $cmd = "perl -I$path -MVcf $path/vcf-stats $file"; 160 my @out = `$cmd 2>&1`; 161 open(my $fh,'<',"$file.stats") or confess("$file.stats: $!"); 162 my @exp = <$fh>; 163 close($fh); 164 165 is_deeply(\@out,\@exp,"Testing vcf-stats .. $cmd"); 166} 167 168sub test_empty_cols 169{ 170 my ($path,$version) = @_; 171 172 my ($header,$vcf,@out,$exp); 173 174 $vcf = Vcf->new(version=>$version); 175 $vcf->add_header_line({key=>'FORMAT', ID=>'GT',Number=>1,Type=>'String',Description=>'Genotype'}); 176 $vcf->add_columns(qw(CHROM POS ID REF ALT QUAL FILTER INFO FORMAT NA0001)); 177 $header = $vcf->format_header(); 178 @out = split(/\n/,$header); 179 $exp = join("\t",qw(CHROM POS ID REF ALT QUAL FILTER INFO FORMAT NA0001)); 180 is_deeply($out[-1],'#'.$exp,"Testing add_columns with genotypes full, $version."); 181 182 $vcf = Vcf->new(version=>$version); 183 $vcf->add_header_line({key=>'FORMAT', ID=>'GT',Number=>1,Type=>'String',Description=>'Genotype'}); 184 $vcf->add_columns('NA0001'); 185 $header = $vcf->format_header(); 186 @out = split(/\n/,$header); 187 $exp = join("\t",qw(CHROM POS ID REF ALT QUAL FILTER INFO FORMAT NA0001)); 188 is_deeply($out[-1],'#'.$exp,"Testing add_columns with genotypes brief, $version."); 189 190 $vcf = Vcf->new(version=>$version); 191 $vcf->add_header_line({key=>'FORMAT', ID=>'GT',Number=>1,Type=>'String',Description=>'Genotype'}); 192 $vcf->add_columns(); 193 $header = $vcf->format_header(); 194 @out = split(/\n/,$header); 195 $exp = join("\t",qw(CHROM POS ID REF ALT QUAL FILTER INFO)); 196 is_deeply($out[-1],'#'.$exp,"Testing add_columns brief, $version."); 197 198 $vcf = Vcf->new(version=>$version); 199 $vcf->add_header_line({key=>'FORMAT', ID=>'GT',Number=>1,Type=>'String',Description=>'Genotype'}); 200 $vcf->add_columns('FORMAT'); 201 $header = $vcf->format_header(); 202 @out = split(/\n/,$header); 203 $exp = join("\t",qw(CHROM POS ID REF ALT QUAL FILTER INFO FORMAT)); 204 is_deeply($out[-1],'#'.$exp,"Testing add_columns no gtypes, $version."); 205} 206 207sub test_compare 208{ 209 my ($path,$a,$b,$expected) = @_; 210 211 my $curdir = `pwd`; 212 chomp($curdir); 213 chdir("$path/../examples"); 214 215 for my $file ($a,$b) 216 { 217 `cat $file | bgzip -c > $file.gz`; 218 `tabix -p vcf -f $file.gz`; 219 } 220 221 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-compare -g $a.gz $b.gz | grep -v '^# The command'"; 222 my @out = `$cmd 2>&1`; 223 open(my $fh,'<',"$expected") or confess("$expected: $!"); 224 my @exp = <$fh>; 225 close($fh); 226 227 chdir($curdir); 228 229 is_deeply(\@out,\@exp,"Testing vcf-compare .. $cmd"); 230} 231 232sub test_merge 233{ 234 my ($path,$expected,@files) = @_; 235 236 my $curdir = `pwd`; 237 chomp($curdir); 238 chdir("$path/../examples"); 239 240 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-merge"; 241 for my $file (@files) 242 { 243 `cat $file | bgzip -c > $file.gz; tabix -f -p vcf $file.gz`; 244 $cmd .= " $file.gz"; 245 } 246 my @out = `$cmd 2>/dev/null | grep -v ^##source`; 247 open(my $fh,'<',$expected) or confess("$expected: $!"); 248 my @exp = <$fh>; 249 close($fh); 250 251 chdir($curdir); 252 is_deeply(\@out,\@exp,"Testing vcf-merge .. $cmd"); 253} 254 255sub test_isec 256{ 257 my ($path,$opts,$expected,@files) = @_; 258 259 my $curdir = `pwd`; 260 chomp($curdir); 261 chdir("$path/../examples"); 262 263 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-isec -f $opts"; 264 for my $file (@files) 265 { 266 `cat $file | bgzip -c > $file.gz; tabix -f -p vcf $file.gz`; 267 $cmd .= " $file.gz"; 268 } 269 my @out = `$cmd 2>&1 | grep -v ^##source`; 270 open(my $fh,'<',$expected) or confess("$expected: $!"); 271 my @exp = <$fh>; 272 close($fh); 273 274 chdir($curdir); 275 is_deeply(\@out,\@exp,"Testing vcf-isec .. $cmd"); 276} 277 278 279sub test_query_vcf 280{ 281 my ($path,$file,$expected,$query) = @_; 282 283 my $curdir = `pwd`; 284 chomp($curdir); 285 chdir("$path/../examples"); 286 287 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-query -f '$query' $file"; 288 my @out = `$cmd 2>&1`; 289 open(my $fh,'<',$expected) or confess("$expected: $!"); 290 my @exp = <$fh>; 291 close($fh); 292 293 chdir($curdir); 294 is_deeply(\@out,\@exp,"Testing vcf-query .. $cmd"); 295} 296 297 298sub test_shuffle 299{ 300 my ($path,$template,$file) = @_; 301 302 my $curdir = `pwd`; 303 chomp($curdir); 304 chdir("$path/../examples"); 305 306 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-shuffle-cols -t $template $file"; 307 my @out = `$cmd 2>&1`; 308 open(my $fh,'<',$template) or confess("$template: $!"); 309 my @exp = <$fh>; 310 close($fh); 311 312 chdir($curdir); 313 is_deeply(\@out,\@exp,"Testing vcf-shuffle-cols .. $cmd"); 314} 315 316sub test_concat 317{ 318 my ($path,$out,@files) = @_; 319 320 my $curdir = `pwd`; 321 chomp($curdir); 322 chdir("$path/../examples"); 323 324 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-concat -s 3"; 325 for my $file (@files) 326 { 327 `cat $file | bgzip -c > $file.gz`; 328 `tabix -p vcf -f $file.gz`; 329 $cmd .= " $file.gz"; 330 } 331 332 my @out = `$cmd 2>&1`; 333 open(my $fh,'<',$out) or confess("$out: $!"); 334 my @exp = <$fh>; 335 close($fh); 336 337 chdir($curdir); 338 is_deeply(\@out,\@exp,"Testing vcf-concat .. $cmd"); 339} 340 341 342sub test_annotate 343{ 344 my ($path,$args,$out,$vcf,$annot) = @_; 345 346 my $curdir = `pwd`; 347 chomp($curdir); 348 chdir("$path/../examples"); 349 350 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-annotate $args $vcf"; 351 352 if ( defined $annot ) 353 { 354 `cat $annot | bgzip -c > $annot.gz`; 355 `tabix -s 3 -b 1 -e 2 -f $annot.gz`; 356 $cmd .= " -a $annot.gz"; 357 } 358 359 my @out = `$cmd 2>&1 | grep -v ^##source`; 360 open(my $fh,'<',$out) or confess("$out: $!"); 361 my @exp = <$fh>; 362 close($fh); 363 364 chdir($curdir); 365 is_deeply(\@out,\@exp,"Testing vcf-annotate .. $cmd"); 366} 367 368sub test_fill_an_ac 369{ 370 my ($path,$out,$vcf) = @_; 371 372 my $curdir = `pwd`; 373 chomp($curdir); 374 chdir("$path/../examples"); 375 376 my $cmd = "perl -I../perl/ -MVcf ../perl/fill-an-ac $vcf"; 377 my @out = `$cmd 2>&1`; 378 open(my $fh,'<',$out) or confess("$out: $!"); 379 my @exp = <$fh>; 380 close($fh); 381 382 chdir($curdir); 383 is_deeply(\@out,\@exp,"Testing fill-an-ac .. $cmd"); 384} 385 386sub test_indel_stats 387{ 388 my ($path,$out,$vcf,$tab) = @_; 389 390 my $curdir = `pwd`; 391 chomp($curdir); 392 chdir("$path/../examples"); 393 394 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-indel-stats -e $tab < $vcf"; 395 my @out = `$cmd 2>&1`; 396 open(my $fh,'<',$out) or confess("$out: $!"); 397 my @exp = <$fh>; 398 close($fh); 399 400 chdir($curdir); 401 is_deeply(\@out,\@exp,"Testing fill-an-ac .. $cmd"); 402} 403 404sub test_consensus 405{ 406 my ($path,$args,$out,$vcf,$fa) = @_; 407 408 my $curdir = `pwd`; 409 chomp($curdir); 410 chdir("$path/../examples"); 411 `cat $vcf | bgzip -c > $vcf.gz`; 412 `tabix -p vcf -f $vcf.gz`; 413 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-consensus $args $vcf.gz < $fa"; 414 my @out = `$cmd`; 415 open(my $fh,'<',$out) or confess("$out: $!"); 416 my @exp = <$fh>; 417 close($fh); 418 419 chdir($curdir); 420 is_deeply(\@out,\@exp,"Testing vcf-consensus .. $cmd"); 421} 422 423sub test_contrast 424{ 425 my ($path,$args,$out,$vcf) = @_; 426 my $curdir = `pwd`; 427 chomp($curdir); 428 chdir("$path/../examples"); 429 my $cmd = "perl -I../perl/ -MVcf ../perl/vcf-contrast $args $vcf | grep -v ^##source"; 430 my @out = `$cmd 2>&1`; 431 open(my $fh,'<',$out) or confess("$out: $!"); 432 my @exp = <$fh>; 433 close($fh); 434 435 chdir($curdir); 436 is_deeply(\@out,\@exp,"Testing vcf-contrast .. $cmd"); 437} 438 439sub test_ploidy 440{ 441 my ($path,$prefix) = @_; 442 my $curdir = `pwd`; 443 chomp($curdir); 444 chdir("$path/../examples"); 445 my $cmd = "cat $prefix.vcf | perl -I../perl/ -MVcf ../perl/vcf-fix-ploidy -s $prefix.samples -p $prefix.txt 2>/dev/null | vcf-query -f '\%POS[\\t\%SAMPLE \%GTR \%PL]\\n'"; 446 my @out = `$cmd 2>&1`; 447 open(my $fh,'<',"$prefix.out") or confess("$prefix.out: $!"); 448 my @exp = <$fh>; 449 close($fh); 450 451 chdir($curdir); 452 is_deeply(\@out,\@exp,"Testing vcf-fix-ploidy .. $cmd"); 453} 454 455sub test_api_event_type 456{ 457 my (@subs) = @_; 458 my $vcf = Vcf->new(); 459 for my $mut (@subs) 460 { 461 my $exp = join(' ', $vcf->event_type($$mut[0],$$mut[1])); 462 is_deeply($$mut[2],$exp,"Testing API event_type($$mut[0],$$mut[1]) .. $exp"); 463 } 464} 465 466sub test_api 467{ 468 my $vcf = Vcf->new(); 469 470 my $ret; 471 my $fmt = 'GT:GL:PL'; 472 $ret = $vcf->get_tag_index($fmt,'GT',':'); is($ret,0,"Testing get_tag_index($fmt,'GT',':')"); 473 $ret = $vcf->get_tag_index($fmt,'GL',':'); is($ret,1,"Testing get_tag_index($fmt,'GL',':')"); 474 $ret = $vcf->get_tag_index($fmt,'PL',':'); is($ret,2,"Testing get_tag_index($fmt,'PL',':')"); 475 476 $ret = $vcf->remove_field($fmt,0,':'); is($ret,'GL:PL',"Testing get_tag_index($fmt,0,':')"); 477 $ret = $vcf->remove_field($fmt,1,':'); is($ret,'GT:PL',"Testing get_tag_index($fmt,1,':')"); 478 $ret = $vcf->remove_field($fmt,2,':'); is($ret,'GT:GL',"Testing get_tag_index($fmt,2,':')"); 479 480 $ret = $vcf->replace_field($fmt,'XX',0,':'); is($ret,'XX:GL:PL',"Testing get_tag_index($fmt,'XX',0,':')"); 481 $ret = $vcf->replace_field($fmt,'XX',1,':'); is($ret,'GT:XX:PL',"Testing get_tag_index($fmt,'XX',1,':')"); 482 $ret = $vcf->replace_field($fmt,'XX',2,':'); is($ret,'GT:GL:XX',"Testing get_tag_index($fmt,'XX',2,':')"); 483 $ret = $vcf->replace_field($fmt,'XX',4,':'); is($ret,'GT:GL:PL::XX',"Testing get_tag_index($fmt,'XX',4,':')"); 484 485 $ret = $vcf->decode_genotype('C',[qw(G T)],'0/1/2|1/0|1|2'); is($ret,'C/G/T|G/C|G|T',"Testing decode_genotype('C',['G','T'],'0/1/2|1/0|1|2')"); 486 $ret = $vcf->decode_genotype('C',[qw(G T)],'2|1'); is($ret,'T|G',"Testing decode_genotype('C',['G','T'],'2|1')"); 487 $ret = $vcf->decode_genotype('C',[qw(G T)],'2'); is($ret,'T',"Testing decode_genotype('C',['G','T'],'2')"); 488 489 my $info = 'NS=2;HM;AF=0.333;AFA=T;DB'; 490 $ret = $vcf->get_info_field($info,'NS'); is($ret,'2',"Testing get_info_field($info,'NS')"); 491 $ret = $vcf->get_info_field($info,'AF'); is($ret,'0.333',"Testing get_info_field($info,'AF')"); 492 $ret = $vcf->get_info_field($info,'AFA'); is($ret,'T',"Testing get_info_field($info,'AFA')"); 493 $ret = $vcf->get_info_field($info,'HM'); is($ret,'1',"Testing get_info_field($info,'HM')"); 494 $ret = $vcf->get_info_field($info,'DB'); is($ret,'1',"Testing get_info_field($info,'DB')"); 495 $ret = $vcf->get_info_field($info,'DBX'); is($ret,undef,"Testing get_info_field($info,'DBX')"); 496 $ret = $vcf->get_info_field('DB','DB'); is($ret,'1',"Testing get_info_field('DB','DB')"); 497 $ret = $vcf->get_info_field('XDB','DB'); is($ret,undef,"Testing get_info_field('XDB','DB')"); 498 499 my @ret; 500 @ret = $vcf->split_gt('0/1'); is_deeply(\@ret,[0,1],"Testing split_gt('0/1')"); 501 @ret = $vcf->split_gt('0'); is_deeply(\@ret,[0],"Testing split_gt('0')"); 502 503 my @als; 504 @als = ("TTGGTAT","TTGGTATCTAGTGGTAT,TGGTATCTAGTGGTAT"); @ret = $vcf->normalize_alleles(@als); 505 is_deeply(\@ret,["T","TTGGTATCTAG","TGGTATCTAG"],"Testing normalize_alleles(".join(',',@als).")"); 506 @als = ("TT","TCTAGTGGTAAT,TCT"); @ret = $vcf->normalize_alleles(@als); 507 is_deeply(\@ret,["T","TCTAGTGGTAA","TC"],"Testing normalize_alleles(".join(',',@als).")"); 508 @als = ("TGGGGGG","TGGGGGGG"); @ret = $vcf->normalize_alleles(@als); 509 is_deeply(\@ret,["T","TG"],"Testing normalize_alleles(".join(',',@als).")"); 510 @als = ("CAAAAAA","CAAAAA"); @ret = $vcf->normalize_alleles(@als); 511 is_deeply(\@ret,["CA","C"],"Testing normalize_alleles(".join(',',@als).")"); 512 @als = ("CA","CT"); @ret = $vcf->normalize_alleles(@als); 513 is_deeply(\@ret,["CA","CT"],"Testing normalize_alleles(".join(',',@als).")"); 514 @als = ("GAACCCACA","GA"); @ret = $vcf->normalize_alleles_pos(@als); 515 is_deeply(\@ret,[0,"GAACCCAC","G"],"Testing normalize_alleles_pos(".join(',',@als).")"); 516 @als = ("CAGTAAAA","CAGAAAA"); @ret = $vcf->normalize_alleles_pos(@als); 517 is_deeply(\@ret,[2,"GT","G"],"Testing normalize_alleles_pos(".join(',',@als).")"); 518 @als = ("CAGTAAA","CAGAAAA"); @ret = $vcf->normalize_alleles_pos(@als); 519 is_deeply(\@ret,[3,"T","A"],"Testing normalize_alleles_pos(".join(',',@als).")"); 520 @als = ("GA","GACC"); @ret = $vcf->normalize_alleles_pos(@als); 521 is_deeply(\@ret,[1,"A","ACC"],"Testing normalize_alleles_pos(".join(',',@als).")"); 522} 523 524 525