1# -*-Perl-*- Test Harness script for Bioperl
2# $Id$
3
4use strict;
5
6BEGIN {
7    use Bio::Root::Test;
8
9    test_begin(-tests => 35);
10
11    use_ok('Bio::Root::Storable');
12}
13
14foreach 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}
79