The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*-Perl-*- Test Harness script for Bioperl
# $Id$

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;