t/unit_fixture/SGN/View/Feature.t

   1 package Test::SGN::View::Feature;
   2 use strict;
   3 use warnings;
   4 use base 'Test::Class';
   5
   6 use Test::Class;
   7 use Test::More tests => 19;
   8 use Test::Exception;
   9
  10 use Data::Dump;
  11 use List::MoreUtils qw/ any /;
  12
  13 use lib 't/lib';
  14 use SGN::Test::Data qw/create_test/;
  15
  16 use_ok('SGN::View::Feature', qw/
  17     feature_table related_stats cvterm_link
  18     feature_link organism_link
  19     mrna_cds_protein_sequence
  20 / );
  21
  22 sub make_fixture : Test(setup) {
  23     my $self = shift;
  24     $self->{feature} = create_test('Sequence::Feature');
  25 }
  26
  27 sub teardown : Test(teardown) {
  28     my $self = shift;
  29     # SGN::Test::Data objects self-destruct, don't clean them up here!
  30 }
  31
  32 sub TEST_MRNA_CDS_PROTEIN_SEQUENCE : Tests {
  33     my $self = shift;
  34     my $f = $self->{feature};
  35
  36     lives_ok( sub { mrna_cds_protein_sequence($f) } );
  37 }
  38
  39 sub TEST_FEATURE_TABLE : Tests {
  40     my $self = shift;
  41     my $f = $self->{feature};
  42     my %table_data = feature_table( [$f] );
  43     is( scalar @{$table_data{data}}, 1, 'got one row for the one, unlocated feature' );
  44     table_row_contains( $table_data{data}->[0], 'not located', 'says feature is not located' );
  45     table_row_contains( $table_data{data}->[0], $f->name, 'has feature name' );
  46     table_row_contains( $table_data{data}->[0], $f->organism->species, 'has species' );
  47
  48 }
  49
  50 sub TEST_UTR_LENGTHS : Tests {
  51     my $self = shift;
  52     local *_calc = sub {
  53         SGN::View::Feature::_calculate_cdna_utr_lengths(
  54             _make_range( @{+shift} ),
  55             [ map { _make_range(@$_) } @_ ]
  56         )
  57     };
  58
  59     is_deeply( [ _calc( [6,10,1], [1,3,1], [5,10,1] ) ],
  60                [ 4, 0 ]
  61              );
  62     is_deeply( [ _calc( [6,10,1], [1,3,1], [5,20,1] ) ],
  63                [ 4, 10 ]
  64              );
  65     is_deeply( [ _calc( [1,10,1], [1,3,1], [5,20,1] ) ],
  66                [ 0, 10 ]
  67              );
  68 }
  69
  70 sub _make_range {
  71     Bio::Range->new( -start => shift, -end => shift, -strand => shift );
  72 }
  73
  74 sub table_row_contains {
  75     my $row = shift;
  76     my $substr  = shift;
  77     my $name = shift;
  78     ok( ( any { index($_,$substr) != -1 } @$row ), $name )
  79        or diag "$substr not found in ".Data::Dump::dump( $row );
  80 }
  81
  82 sub TEST_CVTERM_LINK : Tests {
  83     my $self = shift;
  84     my $f = $self->{feature};
  85     my ($id,$name) = ($f->type->cvterm_id,$f->type->name);
  86     $name =~ s/_/ /g;
  87     my $link = qq{<a href="/cvterm/$id/view">$name</a>};
  88     is(cvterm_link($f->type),$link, 'cvterm link');
  89 }
  90
  91 sub TEST_RELATED_STATS : Tests {
  92     my $self = shift;
  93     my $feature = create_test('Sequence::Feature');
  94
  95     my $name1 = cvterm_link( $self->{feature}->type );
  96     my $name2 = cvterm_link( $feature->type );
  97     my $stats = related_stats([ $self->{feature}, $feature, $feature ]);
  98     is($stats->[0][1], $name1);
  99     is($stats->[0][0], 1);
 100     is($stats->[1][0], 2);
 101     is($stats->[1][1], $name2);
 102     is($stats->[2][0], 3);
 103     like($stats->[2][1] , qr'Total');
 104 }
 105
 106 sub TEST_ORGANISM_LINK : Tests {
 107     my $self = shift;
 108     my $o             = create_test('Organism::Organism');
 109     my ($id,$species) = ($o->organism_id,$o->species);
 110     my $link          = qq{<a class="species_binomial" href="/chado/organism.pl?organism_id=$id">$species</a>};
 111     is(organism_link($o),$link, 'organism_link on a organism');
 112 }
 113
 114 sub TEST_FEATURE_LINK : Tests {
 115     my $self = shift;
 116     my $f          = $self->{feature};
 117     my ($id,$name) = ($f->feature_id,$f->name);
 118     my $link       = qq{<a href="/feature/$id/details">$name</a>};
 119     is(feature_link($f),$link, 'feature_link on a feature');
 120     is(feature_link(),'<span class="ghosted">null</span>','feature_link returns a ghosted null when not given a feature');
 121 }
 122
 123 Test::Class->runtests;