t/CodonTable.t

   1 #-*-Perl-*-
   2 ## Bioperl Test Harness Script for Modules
   3 ## $Id$
   4
   5 # Before `make install' is performed this script should be runnable with
   6 # `make test'. After `make install' it should work as `perl test.t'
   7
   8 use strict;
   9 BEGIN {
  10     # to handle systems with no installed Test module
  11     # we include the t dir (where a copy of Test.pm is located)
  12     # as a fallback
  13     eval { require Test; };
  14     if( $@ ) {
  15         use lib 't';
  16     }
  17     use Test;
  18
  19     plan tests => 30;
  20 }
  21 use Bio::Tools::CodonTable;
  22 use vars qw($DEBUG);
  23 ok(1);
  24
  25 # create a table object by giving an ID
  26 $DEBUG = 0;
  27 my $myCodonTable = Bio::Tools::CodonTable -> new ( -id => 16);
  28 ok defined $myCodonTable;
  29 ok $myCodonTable->isa('Bio::Tools::CodonTable');
  30
  31 # defaults to ID 1 "Standard"
  32 $myCodonTable = Bio::Tools::CodonTable->new();
  33 ok $myCodonTable->id(), 1;
  34
  35
  36 # change codon table
  37 $myCodonTable->id(10);
  38 ok $myCodonTable->id, 10;
  39
  40 ok $myCodonTable->name(), 'Euplotid Nuclear';
  41
  42 # translate codons
  43 $myCodonTable->id(1);
  44
  45 eval {
  46     $myCodonTable->translate();
  47 };
  48 ok ($@ =~ /EX/) ;
  49
  50 ok $myCodonTable->translate(''), '';
  51
  52 my @ii  = qw(ACT acu ATN gt ytr sar);
  53 my @res = qw(T   T   X   V  L   Z  );
  54 my $test = 1;
  55 for my $i (0..$#ii) {
  56     if ($res[$i] ne $myCodonTable->translate($ii[$i]) ) {
  57         $test = 0;
  58         print $ii[$i], ": |", $res[$i], "| ne |", $myCodonTable->translate($ii[$i]), "|\n" if( $DEBUG);
  59         last ;
  60     }
  61 }
  62 ok ($test);
  63 ok $myCodonTable->translate('ag'), '';
  64 ok $myCodonTable->translate('jj'), '';
  65 ok $myCodonTable->translate('jjg'), 'X';
  66 ok $myCodonTable->translate('gt'), 'V';
  67 ok $myCodonTable->translate('g'), '';
  68
  69 # a more comprehensive test on ambiguous codes
  70 my $seq = <<SEQ;
  71 atgaaraayacmacracwackacyacsacvachacdacbacxagragyatmatwatyathcarcayc
  72 cmccrccwcckccyccsccvcchccdccbccxcgmcgrcgwcgkcgycgscgvcghcgdcgbcgxctmctrct
  73 wctkctyctsctvcthctdctbctxgargaygcmgcrgcwgckgcygcsgcvgchgcdgcbgcxggmggrggw
  74 ggkggyggsggvgghggdggbggxgtmgtrgtwgtkgtygtsgtvgthgtdgtbgtxtartaytcmtcrtcwt
  75 cktcytcstcvtchtcdtcbtcxtgyttrttytramgamggmgrracratrayytaytgytrsaasagsartaa;
  76 SEQ
  77     $seq =~ s/\s+//g;
  78 @ii = grep { length == 3 } split /(.{3})/, $seq;
  79 print join (' ', @ii), "\n" if( $DEBUG);
  80 my $prot = <<PROT;
  81 MKNTTTTTTTTTTTRSIIIIQHPPPPPPPPPPPRRRRRRRRRRRLLLLLLLLLLLEDAAAAAAAAAAAGGG
  82 GGGGGGGGVVVVVVVVVVV*YSSSSSSSSSSSCLF*RRRBBBLLLZZZ*
  83 PROT
  84
  85     $prot =~ s/\s//;
  86 @res = split //, $prot;
  87 print join (' ', @res), "\n" if( $DEBUG );
  88 $test = 1;
  89 for my $i (0..$#ii) {
  90     if ($res[$i] ne $myCodonTable->translate($ii[$i]) ) {
  91         $test = 0;
  92         print $ii[$i], ": |", $res[$i], "| ne |",
  93           $myCodonTable->translate($ii[$i]),  "| @ $i\n" if( $DEBUG);
  94         last ;
  95     }
  96 }
  97 ok $test;
  98
  99 # reverse translate amino acids
 100
 101 ok $myCodonTable->revtranslate('J'), 0;
 102
 103
 104 @ii = qw(A l ACN Thr sER ter Glx);
 105 @res = (
 106         [qw(gct gcc gca gcg)],
 107         [qw(ggc gga ggg act acc aca acg)],
 108         [qw(tct tcc tca tcg agt agc)],
 109         [qw(act acc aca acg)],
 110         [qw(tct tcc tca tcg agt agc)],
 111         [qw(taa tag tga)],
 112         [qw(gaa gag caa cag)]
 113         );
 114
 115 $test = 1;
 116  TESTING: {
 117      for my $i (0..$#ii) {
 118          my @codonres = $myCodonTable->revtranslate($ii[$i]);
 119          for my $j (0..$#codonres) {
 120              if ($codonres[$j] ne $res[$i][$j]) {
 121                  $test = 0;
 122                  print $ii[$i], ': ', $codonres[$j], " ne ",
 123                  $res[$i][$j], "\n" if( $DEBUG);
 124                  last TESTING;
 125              }
 126          }
 127      }
 128  }
 129 ok $test;
 130
 131 #  boolean tests
 132 $myCodonTable->id(1);
 133
 134 ok $myCodonTable->is_start_codon('ATG');
 135 ok( $myCodonTable->is_start_codon('GGH'), 0);
 136 ok $myCodonTable->is_start_codon('HTG');
 137 ok $myCodonTable->is_start_codon('CCC'), 0;
 138
 139 ok $myCodonTable->is_ter_codon('UAG');
 140 ok $myCodonTable->is_ter_codon('TaG');
 141 ok $myCodonTable->is_ter_codon('TaR');
 142 ok $myCodonTable->is_ter_codon('tRa');
 143 ok $myCodonTable->is_ter_codon('ttA'), 0;
 144
 145 ok $myCodonTable->is_unknown_codon('jAG');
 146 ok $myCodonTable->is_unknown_codon('jg');
 147 ok $myCodonTable->is_unknown_codon('UAG'), 0;
 148
 149
 150 ok $myCodonTable->translate_strict('ATG'), 'M';