t/Root/Storable.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 => 35);
  11
  12     use_ok('Bio::Root::Storable');
  13 }
  14
  15 foreach my $mode( "BINARY", "ASCII" ){
  16     if( $mode eq "ASCII" ){
  17         no warnings;
  18         $Bio::Root::Storable::BINARY = 0;
  19     }
  20
  21     #------------------------------
  22     # Test the easy bits that don't need file IO
  23     my $obj = Bio::Root::Storable->new();
  24     ok defined($obj) && $obj->isa('Bio::Root::Storable');
  25
  26     eval { $obj->throw('Testing throw') };
  27     ok $@ =~ /Testing throw/;   # 'throw failed';
  28
  29     $obj->{_test}  = "_TEST";   # Provide test attributes
  30     $obj->{__test} = "__TEST";  #
  31
  32     my $state = $obj->serialise;
  33     ok length($state) > 0;
  34
  35     my $clone = $obj->clone;
  36     ok defined($clone) and $clone->isa('Bio::Root::Storable');
  37     ok $clone->{_test} eq "_TEST" && $clone->{__test}  eq "__TEST";
  38
  39     #------------------------------
  40     # Test standard file IO
  41     my $file = $obj->store;
  42     ok $file && -f $obj->statefile;
  43
  44     my $retrieved;
  45     eval { $retrieved = Bio::Root::Storable->retrieve( $file ) };
  46     ok defined($retrieved) && $retrieved->isa('Bio::Root::Storable');
  47     ok $retrieved->{_test} eq "_TEST" && ! exists $retrieved->{__test};
  48
  49     my $skel = $obj->new_retrievable;
  50     ok defined($skel) && $skel->isa('Bio::Root::Storable');
  51     ok ! exists $skel->{_test} && ! exists $skel->{__test};
  52     ok $skel->retrievable;
  53
  54     eval { $skel->retrieve };
  55     ok ! $skel->retrievable;
  56     ok $skel->{_test} eq "_TEST" && ! exists $skel->{__test};
  57
  58     my $obj2 = Bio::Root::Storable->new();
  59     $obj2->template('TEST_XXXXXX');
  60     $obj2->suffix('.state');
  61     my $file2 = $obj2->store;
  62     ok $file2 =~ /TEST_\w{6}?\.state$/ and -f $file2;
  63
  64     #------------------------------
  65     # Test recursive file IO
  66     $obj->{_test_lazy} = $obj2;
  67     $obj->store;
  68     my $retrieved2;
  69     eval { $retrieved2 = Bio::Root::Storable->retrieve( $obj->token ) };
  70     ok $retrieved2->{_test_lazy} && $retrieved2->{_test_lazy}->retrievable;
  71
  72     #------------------------------
  73     # Clean up
  74     # Should only be 2 object files; all others were clones in one way or another
  75     $obj->remove;
  76     ok ! -f $obj->statefile;
  77     $obj2->remove;
  78     ok ! -f $obj2->statefile;
  79 }