t/Tempfile.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::More module
  12     # we include the t dir (where a copy of Test/More.pm is located)
  13     # as a fallback
  14     eval { require Test::More; };
  15     if( $@ ) {
  16                 use lib 't/lib';
  17     }
  18     use Test::More tests => 18;
  19 }
  20
  21 use_ok('Bio::Root::IO');
  22
  23 ok my $obj = Bio::Root::IO->new(-verbose => 0);
  24
  25 isa_ok($obj, 'Bio::Root::IO');
  26
  27 my $TEST_STRING = "Bioperl rocks!\n";
  28
  29 my ($tfh,$tfile);
  30
  31 eval {
  32     ($tfh,$tfile) = $obj->tempfile();
  33     print $tfh $TEST_STRING;
  34     close($tfh);
  35     open(my $IN, $tfile) or die("cannot open $tfile");
  36     my $val = join("", <$IN>) ;
  37     ok( $val eq $TEST_STRING );
  38     close $IN;
  39     ok( -e $tfile );
  40     undef $obj;
  41 };
  42 undef $obj;
  43 if( $@ ) {
  44     ok(0);
  45 } else {
  46    ok( ! -e $tfile, 'auto UNLINK => 1' );
  47 }
  48
  49 $obj = Bio::Root::IO->new();
  50
  51 eval {
  52     my $tdir = $obj->tempdir(CLEANUP=>1);
  53     ok( -d $tdir );
  54     ($tfh, $tfile) = $obj->tempfile(dir => $tdir);
  55     close $tfh;
  56     ok( -e $tfile );
  57     undef $obj; # see Bio::Root::IO::_io_cleanup
  58 };
  59
  60 if( $@ ) { ok(0); }
  61 else { ok( ! -e $tfile, 'tempfile deleted' ); }
  62
  63 eval {
  64     $obj = Bio::Root::IO->new(-verbose => 0);
  65     ($tfh, $tfile) = $obj->tempfile(UNLINK => 0);
  66     close $tfh;
  67     ok( -e $tfile );
  68     undef $obj; # see Bio::Root::IO::_io_cleanup
  69 };
  70
  71 if( $@ ) { ok(0) }
  72 else { ok( -e $tfile, 'UNLINK => 0') }
  73
  74 ok unlink( $tfile) == 1 ;
  75
  76
  77 ok $obj = Bio::Root::IO->new;
  78
  79 # check suffix is applied
  80 my($fh1, $fn1) = $obj->tempfile(SUFFIX => '.bioperl');
  81 ok $fh1;
  82 like $fn1, qr/\.bioperl$/, 'tempfile suffix';
  83 ok close $fh1;
  84
  85 # check single return value mode of File::Temp
  86 my $fh2 = $obj->tempfile;
  87 ok $fh2, 'tempfile() in scalar context';
  88 ok close $fh2;
  89
  90
  91 1;
  92
  93