t/RootIO.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
  10 BEGIN {
  11     # to handle systems with no installed Test module
  12     # we include the t dir (where a copy of Test.pm is located)
  13     # as a fallback
  14     eval { require Test; };
  15     if( $@ ) {
  16         use lib 't', '.';
  17     }
  18     use Test;
  19     plan tests => 25;
  20
  21 }
  22
  23 $| = 1;
  24
  25 use Bio::Root::IO;
  26
  27 my $obj = new Bio::Root::IO();
  28 ok defined($obj) && $obj->isa('Bio::Root::IO');
  29
  30 eval { $obj->throw('Testing throw') };
  31 ok $@ =~ /Testing throw/;# 'throw failed';
  32
  33 $obj->verbose(-1);
  34 eval { $obj->throw('Testing throw') };
  35 ok $@=~ /Testing throw/;# 'verbose(-1) throw did not work properly' . $@;
  36
  37 eval { $obj->warn('Testing warn') };
  38 ok !$@;
  39
  40 $obj->verbose(1);
  41 eval { $obj->throw('Testing throw') };
  42 ok $@ =~ /Testing throw/;# 'verbose(1) throw did not work properly' . $@;
  43
  44 my @stack = $obj->stack_trace();
  45 ok scalar @stack, 2;
  46
  47 my $verbobj = new Bio::Root::IO(-verbose=>1,-strict=>1);
  48 ok $verbobj->verbose(), 1;
  49
  50 ok $obj->verbose(-1);
  51
  52 #############################################
  53 # <tests for handle read and write abilities>
  54 #############################################
  55 my($handle,$file) = $obj->tempfile;
  56
  57 ok open(I,"t/data/test.waba");
  58 ok open(O,">$file");
  59
  60 my $rio;
  61 my $wio;
  62
  63 #test with files
  64 ok $rio = Bio::Root::IO->new(-file=>"t/data/test.waba");
  65 ok $wio = Bio::Root::IO->new(-file=>">$file");
  66
  67 ok $rio->mode eq 'r';
  68
  69 ok $wio->mode eq 'w';
  70
  71 #test with handles
  72 ok $rio = Bio::Root::IO->new(-fh=>\*I);
  73 ok $wio = Bio::Root::IO->new(-fh=>\*O);
  74 ok $rio->mode eq 'r';
  75 ok $wio->mode eq 'w';
  76
  77 ##############################################
  78 # </tests for handle read and write abilities>
  79 ##############################################
  80
  81 ##############################################
  82 # <tests _pushback for multi-line buffering>
  83 ##############################################
  84
  85 my $line1 = $rio->_readline;
  86 my $line2 = $rio->_readline;
  87
  88 ok $rio->_pushback($line1);
  89 ok $rio->_pushback($line2);
  90
  91 my $line3 = $rio->_readline;
  92 my $line4 = $rio->_readline;
  93 my $line5 = $rio->_readline;
  94
  95 ok $line1 eq $line3;
  96 ok $line2 eq $line4;
  97 ok $line5 ne $line4;
  98
  99 ##############################################
 100 # </tests _pushback for multi-line buffering>
 101 ##############################################
 102
 103 ok close(I);
 104 ok close(O);
 105
 106
 107 1;