t/seqread_fail.t

   1 # This is -*-Perl-*- code
   2 ## Bioperl Test Harness Script for Modules
   3 ##
   4 # $Id$
   5
   6 # Before `make install' is performed this script should be runnable with
   7 # `make test'. After `make install' it should work as `perl test.t'
   8
   9 use strict;
  10 #use lib '..','.','./blib/lib';
  11 use vars qw($NUMTESTS $DEBUG);
  12 $DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
  13
  14 my $error;
  15
  16 BEGIN {
  17         # to handle systems with no installed Test module
  18         # we include the t dir (where a copy of Test.pm is located)
  19         # as a fallback
  20         eval { require Test; };
  21         $error = 0;
  22         if( $@ ) {
  23                 use lib 't';
  24         }
  25         use Test;
  26
  27         $NUMTESTS = 13;
  28         plan tests => $NUMTESTS;
  29
  30         eval { require IO::String;
  31                          require LWP::UserAgent;
  32                          require HTTP::Request::Common;
  33        };
  34         if( $@ ) {
  35                 print STDERR "IO::String or LWP::UserAgent or HTTP::Request not installed. This means the Bio::DB::* modules are not usable. Skipping tests.\n";
  36                 for( 1..$NUMTESTS ) {
  37                         skip("IO::String, LWP::UserAgent,or HTTP::Request not installed",1);
  38                 }
  39                 $error = 1;
  40         }
  41 }
  42
  43 END {
  44         foreach ( $Test::ntest..$NUMTESTS) {
  45                 skip('Unable to run all of the DB tests',1);
  46         }
  47 }
  48
  49
  50 if( $error ==  1 ) {
  51     exit(0);
  52 }
  53
  54
  55 require Bio::DB::GenBank;
  56 require Bio::DB::GenPept;
  57 require Bio::DB::SwissProt;
  58 require Bio::DB::RefSeq;
  59 require Bio::DB::EMBL;
  60 require Bio::DB::BioFetch;
  61
  62 my $verbose = -1;
  63 $verbose = 0 if $DEBUG;
  64
  65 sub fetch {
  66     my ($id, $class) = @_;
  67     print "###################### $class  ####################################\n" if $DEBUG;
  68     my $seq;
  69     ok defined ( my $gb = new $class('-verbose'=>$verbose,'-delay'=>0) );
  70     eval { $seq = $gb->get_Seq_by_id($id) };
  71     if( $@ or not defined$seq ) {
  72         ok 1;
  73         return;
  74     }
  75     ok 0;
  76 }
  77
  78 my @classes = qw( Bio::DB::BioFetch Bio::DB::GenBank Bio::DB::GenPept
  79                   Bio::DB::SwissProt Bio::DB::RefSeq Bio::DB::EMBL  );
  80
  81 my $id = 'XXX111';  # nonsense id
  82
  83 for (@classes) {
  84     fetch ($id, $_);
  85 }
  86
  87 ok 1;