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