t/qual.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib 't/lib';
   8     use BioperlTest;
   9
  10     test_begin(-tests => 21);
  11
  12         use_ok('Bio::SeqIO');
  13         use_ok('Bio::Seq::PrimaryQual');
  14 }
  15
  16 my $DEBUG = test_debug();
  17
  18 my $in_qual  = Bio::SeqIO->new('-file' => test_input_file('qualfile.qual'),
  19                                '-format' => 'qual');
  20 ok($in_qual);
  21
  22 my @quals;
  23
  24 my $first = 1;
  25 while ( my $qual = $in_qual->next_seq() ) {
  26                 # ::dumpValue($qual);
  27         isa_ok($qual, 'Bio::Seq::PrimaryQual');
  28     @quals = @{$qual->qual()};
  29     if( $DEBUG ) {
  30         warn($qual->id()."\n");
  31
  32         warn("(".scalar(@quals).") quality values.\n");
  33     }
  34     if( $first ) {
  35                 is(@quals, 484);
  36     }
  37     $first = 0;
  38 }
  39
  40 # in October 2004, Carlos Mauricio La Rota posted a problem with descriptions
  41 # this routine is to test that
  42
  43 @quals = 10..20;
  44 # this one has a forced header
  45 my $seq = Bio::Seq::PrimaryQual->new(
  46                     -qual =>   \@quals,
  47                     -header   =>   "Hank is a good cat. I gave him a bath yesterday.");
  48 my $out = Bio::SeqIO->new(-file  =>   ">".test_output_file(),
  49                          -format   =>   'qual');
  50 # yes, that works
  51 is $seq->header, 'Hank is a good cat. I gave him a bath yesterday.';
  52 @quals = @{$seq->qual()};
  53 is scalar(@quals), 11;
  54 ok $out->write_seq($seq);
  55 $seq->header('');
  56 is $seq->header, '';
  57 $seq->id('Hank1');
  58 is $seq->id, 'Hank1';
  59 # yes, that works
  60 ok $out->write_seq($seq);
  61
  62 # bug 2335
  63
  64 $in_qual  = Bio::SeqIO->new('-file' => test_input_file('bug2335.fastq'),
  65                                '-format' => 'fastq');
  66 ok($in_qual);
  67
  68 my $qual = $in_qual->next_seq();
  69 isa_ok($qual, 'Bio::Seq::Quality');
  70 @quals = @{$qual->qual()};
  71 if( $first ) {
  72         is(@quals, 111);
  73 }
  74 my $qualslice = join(',',@quals[0..10]);
  75 is($qualslice, '31,23,32,23,31,22,27,28,32,24,25');