2 use warnings FATAL => 'all';
6 plan skip_all => "Skipping the optimize tests on Win32/cygwin for now."
7 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
9 use t::common qw( new_fh );
11 use_ok( 'DBM::Deep' );
13 my ($fh, $filename) = new_fh();
14 my $db = DBM::Deep->new(
20 # create some unused space
22 $db->{key1} = "value1";
23 $db->{key2} = "value2";
27 $db->{a}{c} = 'value2';
29 my $b = $db->{a}->{b};
47 # take byte count readings before, and after optimize
49 my $before = (stat($filename))[7];
50 my $result = $db->optimize();
51 my $after = (stat($filename))[7];
53 ok( $result, "optimize succeeded" );
54 cmp_ok( $after, '<', $before, "file size has shrunk" ); # make sure file shrunk
56 is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
57 is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );
59 $db->_get_self->_engine->storage->close( $db->_get_self );
62 # now for the tricky one -- try to store a new key while file is being
63 # optimized and locked by another process. filehandle should be invalidated,
64 # and automatically re-opened transparently. Cannot test on Win32, due to
65 # problems with fork()ing, flock()ing, etc. Win32 very bad.
69 skip "Fork tests skipped until fh/filename question solved.", 4;
70 skip "Fork tests skipped on Win32", 4
71 if $^O eq 'MSWin32' || $^O eq 'cygwin';
74 # first things first, get us about 1000 keys so the optimize() will take
75 # at least a few seconds on any machine, and re-open db with locking
77 for (1..1000) { $db->STORE( $_, $_ +1 ); }
81 # now, fork a process for the optimize()
101 ok( defined($pid), "fork was successful" ); # make sure fork was successful
104 $db = DBM::Deep->new(
110 # sleep for 1 second to make sure optimize() is running in the other fork
113 # now, try to get a lock and store a key
114 $db->{parentfork} = "hello";
116 # see if it was stored successfully
117 is( $db->{parentfork}, "hello", "stored key while optimize took place" );
120 $db = DBM::Deep->new(
126 # now check some existing values from before
127 is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
128 is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );