Added faililng tests for autovivification and clear() within transactions

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 2ad8b28..1edb55f 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -498,7 +498,8 @@ sub FETCH {
     ##
     $self->lock( LOCK_SH );
 
-    my $tag = $self->{engine}->find_bucket_list( $self->_base_offset, $md5 );
+    my $tag = $self->{engine}->find_bucket_list( $self->_base_offset, $md5 );#, { create => 1 } );
+    #XXX This needs to autovivify
     if (!$tag) {
         $self->unlock();
         return;

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index c6c1b7f..54609cb 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -709,10 +709,17 @@ sub get_bucket_value {
     my ($tag, $md5, $orig_key) = @_;
 
     #ACID - This is a read. Can find exact or HEAD
-    my ($subloc, $offset, $size,$is_deleted) = $self->_find_in_buckets( $tag, $md5 );
-    if ( $subloc && !$is_deleted ) {
+    my ($subloc, $offset, $size, $is_deleted) = $self->_find_in_buckets( $tag, $md5 );
+
+    if ( !$subloc ) {
+        #XXX Need to use real key
+#        $self->add_bucket( $tag, $md5, $orig_key, undef, undef, $orig_key );
+#        return;
+    }
+    elsif ( !$is_deleted ) {
         return $self->read_from_loc( $subloc, $orig_key );
     }
+
     return;
 }
 

diff --git a/t/02_hash.t b/t/02_hash.t
index d4a52ef..d913e03 100644 (file)
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 32;
+use Test::More tests => 36;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -32,6 +32,15 @@ is( $db->{key3}, 'value3', "... and hash-access also works" );
 ok( $db->exists("key1"), "exists() function works" );
 ok( exists $db->{key2}, "exists() works against tied hash" );
 
+ok( !exists $db->{key4}, "exists() function works for keys that aren't there" );
+is( $db->{key4}, undef, "Autovivified key4" );
+TODO: {
+    local $TODO = "Autovivification isn't correct yet";
+    ok( exists $db->{key4}, "Autovivified key4 now exists" );
+}
+delete $db->{key4};
+ok( !exists $db->{key4}, "And key4 doesn't exists anymore" );
+
 ##
 # count keys
 ##

diff --git a/t/28_transactions.t b/t/28_transactions.t
index ce2a393..9af696e 100644 (file)
--- a/t/28_transactions.t
+++ b/t/28_transactions.t
@@ -1,5 +1,5 @@
 use strict;
-use Test::More tests => 31;
+use Test::More tests => 37;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -60,13 +60,13 @@ is( $db2->{x}, 'z', "After commit, DB2's X is Z" );
 $db1->begin_work;
 
     delete $db2->{other_x};
-    is( $db2->{other_x}, undef, "DB2 deleted other_x in DB1's transaction, so it can't see it anymore" );
+    ok( !exists $db2->{other_x}, "DB2 deleted other_x in DB1's transaction, so it can't see it anymore" );
     is( $db1->{other_x}, 'foo', "Since other_x was deleted after the transaction began, DB1 still sees it." );
 
     delete $db1->{x};
-    is( $db1->{x}, undef, "DB1 deleted X in a transaction, so it can't see it anymore" );
-
+    ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
     is( $db2->{x}, 'z', "But, DB2 can still see it" );
+
 $db1->rollback;
 
 is( $db2->{other_x}, undef, "It's still deleted for DB2" );
@@ -78,10 +78,29 @@ is( $db2->{x}, 'z', "DB2 can still see it" );
 $db1->begin_work;
 
     delete $db1->{x};
-    is( $db1->{x}, undef, "DB1 deleted X in a transaction, so it can't see it anymore" );
+    ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
     is( $db2->{x}, 'z', "But, DB2 can still see it" );
 
 $db1->commit;
 
 is( $db1->{x}, undef, "The transaction was committed, so DB1 still deleted X" );
 is( $db2->{x}, undef, "DB2 can now see the deletion of X" );
+
+$db1->{foo} = 'bar';
+is( $db1->{foo}, 'bar', "Set foo to bar in DB1" );
+is( $db2->{foo}, 'bar', "Set foo to bar in DB2" );
+
+TODO: {
+    local $TODO = 'Still need to work on clear()';
+
+$db1->begin_work;
+
+    %$db1 = (); # clear()
+    ok( !exists $db1->{foo}, "Cleared foo" );
+    is( $db2->{foo}, 'bar', "But in DB2, we can still see it" );
+
+$db1->rollback;
+
+is( $db1->{foo}, 'bar', "Rollback means 'foo' is still there" );
+is( $db2->{foo}, 'bar', "Rollback means 'foo' is still there" );
+}