t/Seq/PrimaryQual.t

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