t/Root/Storable.t

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