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
|
# -*-Perl-*- Test Harness script for Bioperl
# $Id: Tempfile.t 15112 2008-12-08 18:12:38Z sendu $
use strict;
BEGIN {
use lib '.';
use Bio::Root::Test;
test_begin(-tests => 18);
use_ok('Bio::Root::IO');
}
ok my $obj = Bio::Root::IO->new(-verbose => 0);
isa_ok($obj, 'Bio::Root::IO');
my $TEST_STRING = "Bioperl rocks!\n";
my ($tfh,$tfile);
eval {
($tfh,$tfile) = $obj->tempfile();
print $tfh $TEST_STRING;
close($tfh);
open(my $IN, $tfile) or die("cannot open $tfile");
my $val = join("", <$IN>) ;
ok( $val eq $TEST_STRING );
close $IN;
ok( -e $tfile );
undef $obj;
};
undef $obj;
if( $@ ) {
ok(0);
} else {
ok( ! -e $tfile, 'auto UNLINK => 1' );
}
$obj = Bio::Root::IO->new();
eval {
my $tdir = $obj->tempdir(CLEANUP=>1);
ok( -d $tdir );
($tfh, $tfile) = $obj->tempfile(dir => $tdir);
close $tfh;
ok( -e $tfile );
undef $obj; # see Bio::Root::IO::_io_cleanup
};
if( $@ ) { ok(0); }
else { ok( ! -e $tfile, 'tempfile deleted' ); }
eval {
$obj = Bio::Root::IO->new(-verbose => 0);
($tfh, $tfile) = $obj->tempfile(UNLINK => 0);
close $tfh;
ok( -e $tfile );
undef $obj; # see Bio::Root::IO::_io_cleanup
};
if( $@ ) { ok(0) }
else { ok( -e $tfile, 'UNLINK => 0') }
ok unlink( $tfile) == 1 ;
ok $obj = Bio::Root::IO->new;
# check suffix is applied
my($fh1, $fn1) = $obj->tempfile(SUFFIX => '.bioperl');
ok $fh1;
like $fn1, qr/\.bioperl$/, 'tempfile suffix';
ok close $fh1;
# check single return value mode of File::Temp
my $fh2 = $obj->tempfile;
ok $fh2, 'tempfile() in scalar context';
ok close $fh2;
|
