t/Root/RootIO.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests => 31);
  11
  12     use_ok('Bio::Root::IO');
  13 }
  14
  15 my $obj = Bio::Root::IO->new();
  16 ok defined($obj) && $obj->isa('Bio::Root::IO');
  17
  18 #############################################
  19 # tests for exceptions/debugging/verbosity
  20 #############################################
  21
  22 eval { $obj->throw('Testing throw') };
  23 like $@, qr/Testing throw/, 'throw()'; # 'throw failed';
  24
  25 $obj->verbose(-1);
  26 eval { $obj->throw('Testing throw') };
  27 like $@, qr/Testing throw/, 'throw() verbose(-1)'; # 'verbose(-1) throw did not work properly' . $@;
  28
  29 eval { $obj->warn('Testing warn') };
  30 ok !$@, 'warn()';
  31
  32 $obj->verbose(1);
  33 eval { $obj->throw('Testing throw') };
  34 like $@, qr/Testing throw/, 'throw() verbose(1)'; # 'verbose(1) throw did not work properly' . $@;
  35
  36 my @stack = $obj->stack_trace();
  37 is scalar @stack, 2, 'stack_trace()';
  38
  39 my $verbobj = Bio::Root::IO->new(-verbose=>1,-strict=>1);
  40 is $verbobj->verbose(), 1, 'set verbosity to 1';
  41
  42 ok $obj->verbose(-1);
  43
  44 #############################################
  45 # tests for handle read and write abilities
  46 #############################################
  47
  48 ok my $TESTINFILE = Bio::Root::IO->catfile(qw(t data test.waba));
  49
  50 my($handle,$file) = $obj->tempfile;
  51 ok $handle;
  52 ok $file;
  53
  54 #test with files
  55
  56 ok my $rio = Bio::Root::IO->new(-file=>$TESTINFILE);
  57 is $rio->mode, 'r', 'filename, read';
  58
  59 ok my $wio = Bio::Root::IO->new(-file=>">$file");
  60 is $wio->mode, 'w', 'filename, write';
  61
  62 # test with handles
  63
  64 ok open(my $I, $TESTINFILE);
  65 ok open(my $O, '>', $file);
  66
  67 ok $rio = Bio::Root::IO->new(-fh=>$I);
  68 is $rio->mode, 'r', 'handle, read';
  69
  70 ok $wio = Bio::Root::IO->new(-fh=>$O);
  71 is $wio->mode, 'w', 'handle, write';
  72
  73 ##############################################
  74 # tests _pushback for multi-line buffering
  75 ##############################################
  76
  77 my $line1 = $rio->_readline;
  78 my $line2 = $rio->_readline;
  79
  80 ok $rio->_pushback($line1);
  81 ok $rio->_pushback($line2);
  82
  83 my $line3 = $rio->_readline;
  84 my $line4 = $rio->_readline;
  85 my $line5 = $rio->_readline;
  86
  87 is $line1, $line3;
  88 is $line2, $line4;
  89 isnt $line5, $line4;
  90
  91 ok close($I);
  92 ok close($O);
  93
  94 ##############################################
  95 # tests http retrieval
  96 ##############################################
  97
  98 SKIP: {
  99   test_skip(-tests => 2, -requires_networking => 1);
 100
 101   my $TESTURL = 'http://www.google.com/index.html';
 102
 103   ok $rio = Bio::Root::IO->new(-url=>$TESTURL), 'default -url method';
 104
 105   if ($Bio::Root::IO::HAS_LWP) {
 106     $Bio::Root::IO::HAS_LWP = 0;
 107     ok $rio = Bio::Root::IO->new(-url=>$TESTURL), 'non-LWP -url method';
 108   }
 109   else {
 110     ok 1, 'non-LWP -url method not needed as non-LWP was default';
 111   }
 112 }