Committing failing test for freespace staleness

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 6d7f7c8..5c61d37 100644 (file)
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -105,7 +105,7 @@ sub read_value {
 
     # This will be a Reference sector
     my $sector = $self->_load_sector( $obj->_base_offset )
-        or die "How did read_value fail (no sector for '$obj')?!\n";
+        or return;
 
     my $key_md5 = $self->_apply_digest( $key );
 
@@ -136,7 +136,7 @@ sub get_classname {
 
     # This will be a Reference sector
     my $sector = $self->_load_sector( $obj->_base_offset )
-        or die "How did read_value fail (no sector for '$obj')?!\n";
+        or die "How did get_classname fail (no sector for '$obj')?!\n";
 
     return $sector->get_classname;
 }
@@ -147,7 +147,7 @@ sub key_exists {
 
     # This will be a Reference sector
     my $sector = $self->_load_sector( $obj->_base_offset )
-        or die "How did key_exists fail (no sector for '$obj')?!\n";
+        or return '';
 
     my $data = $sector->get_data_for({
         key_md5    => $self->_apply_digest( $key ),
@@ -163,7 +163,7 @@ sub delete_key {
     my ($obj, $key) = @_;
 
     my $sector = $self->_load_sector( $obj->_base_offset )
-        or die "How did delete_key fail (no sector for '$obj')?!\n";
+        or return;
 
     return $sector->delete_key({
         key_md5    => $self->_apply_digest( $key ),
@@ -206,7 +206,7 @@ sub write_value {
 
     # This will be a Reference sector
     my $sector = $self->_load_sector( $obj->_base_offset )
-        or die "How did write_value fail (no sector for '$obj')?!\n";
+        or die "Cannot write to a deleted spot in DBM::Deep.\n";
 
     # Create this after loading the reference sector in case something bad happens.
     # This way, we won't allocate value sector(s) needlessly.
@@ -1435,3 +1435,55 @@ sub get_key_for {
 
 1;
 __END__
+
+package DBM::Deep::Engine::Sector::BucketList;
+
+our @ISA = qw( DBM::Deep::Engine::Sector );
+
+sub _init {
+    my $self = shift;
+
+    my $engine = $self->engine;
+
+    unless ( $self->offset ) {
+        my $leftover = $self->size - $self->base_size;
+
+        $self->{offset} = $engine->_request_sector( $self->size );
+        $engine->storage->print_at( $self->offset,
+            $engine->SIG_BLIST, # Sector type
+            pack( $StP{1}, 0 ), # Recycled counter
+            chr(0) x $leftover, # Zero-fill the data
+        );
+    }
+
+    if ( $self->{key_md5} ) {
+        $self->find_md5;
+    }
+
+    return $self;
+}
+
+sub base_size { 1 + 1 } # Sig + recycled counter
+
+sub size {
+    my $self = shift;
+    unless ( $self->{size} ) {
+        my $e = $self->engine;
+        $self->{size} = $self->base_size + $e->max_buckets * $self->bucket_size; # Base + numbuckets * bucketsize
+    }
+    return $self->{size};
+}
+
+sub bucket_size {
+    my $self = shift;
+    unless ( $self->{bucket_size} ) {
+        my $e = $self->engine;
+        # Key + head (location) + transactions (location + staleness-counter)
+        my $location_size = $e->byte_size + $e->num_txns * ( $e->byte_size + 4 );
+        $self->{bucket_size} = $e->hash_size + $location_size;
+    }
+    return $self->{bucket_size};
+}
+
+1;
+__END__

diff --git a/t/40_freespace.t b/t/40_freespace.t
index 2d01b55..f8a9f09 100644 (file)
--- a/t/40_freespace.t
+++ b/t/40_freespace.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 6;
+use Test::More tests => 11;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -40,3 +40,19 @@ $size = -s $filename;
 $db->{baz} = {};
 
 cmp_ok( $size, '==', -s $filename, "delete and rewrite reuses space" );
+
+my $x = { foo => 'bar' };
+$db->{floober} = $x;
+
+delete $db->{floober};
+
+ok( !exists $x->{foo}, "Deleting floober makes \$x empty (exists)" );
+is( $x->{foo}, undef, "Deleting floober makes \$x empty (read)" );
+is( delete $x->{foo}, undef, "Deleting floober makes \$x empty (delete)" );
+
+eval { $x->{foo} = 'bar'; };
+is( $@, "Cannot write to a deleted spot in DBM::Deep.\n", "Exception thrown when writing" );
+
+$db->{buzzer} = { foo => 'baz' };
+
+ok( !exists $x->{foo}, "Even after the space has been reused, \$x is still empty" );