From: rkinyon Date: Fri, 21 Apr 2006 21:05:26 +0000 (+0000) Subject: Added faililng tests for autovivification and clear() within transactions X-Git-Tag: 0-99_01~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=94e8af141fb179f447c4d1cc8055e920a42c0465;p=dbsrgits%2FDBM-Deep.git 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 --- 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 --- 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 --- 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 --- 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" ); +}