From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
Date: Tue, 26 Dec 2006 04:41:11 +0000 (+0000)
Subject: Fixed bug in reference size counting
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=060c7e54fa88f67be82c977d13cfaf752222a0e7;p=dbsrgits%2FDBM-Deep.git

Fixed bug in reference size counting
---

diff --git a/lib/DBM/Deep/Engine3.pm b/lib/DBM/Deep/Engine3.pm
index 0ba5add..6d7f7c8 100644
--- a/lib/DBM/Deep/Engine3.pm
+++ b/lib/DBM/Deep/Engine3.pm
@@ -949,7 +949,7 @@ sub _init {
 
     unless ( $self->offset ) {
         my $classname = Scalar::Util::blessed( delete $self->{data} );
-        my $leftover = $self->size - 4 - 2 * $engine->byte_size;
+        my $leftover = $self->size - 2 - 2 * $engine->byte_size;
 
         my $class_offset = 0;
         if ( defined $classname ) {
diff --git a/t/38_transaction_add_item.todo b/t/38_transaction_add_item.todo
index 3325e52..993956a 100644
--- a/t/38_transaction_add_item.todo
+++ b/t/38_transaction_add_item.todo
@@ -17,8 +17,8 @@ my $db = DBM::Deep->new(
         foo => 5,
     }, 'Foo';
 
-    cmp_ok( $obj->{foo}, '==', 5 );
-    ok( !exists $obj->{bar} );
+    cmp_ok( $obj->{foo}, '==', 5, "FOO is 5 in the object" );
+    ok( !exists $obj->{bar}, "BAR doesn't exist in the object" );
 
     $db->begin_work;
 
diff --git a/t/40_freespace.t b/t/40_freespace.t
index 7bbaba1..2d01b55 100644
--- a/t/40_freespace.t
+++ b/t/40_freespace.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 4;
+use Test::More tests => 6;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -26,10 +26,17 @@ $size = -s $filename;
 $db->{bar} = '2345';
 cmp_ok( $size, '==', -s $filename, "Added a new key after a delete reuses space" );
 
-__END__
-$db->{bar} = [ 1 .. 3 ];
+$db->{baz} = {};
+$size = -s $filename;
+
+delete $db->{baz};
+$db->{baz} = {};
 
+cmp_ok( $size, '==', -s $filename, "delete and rewrite reuses space" );
+
+$db->{baz} = {};
 $size = -s $filename;
 
-$db->{bar} = [ 3 .. 5 ];
-cmp_ok( $size, '==', -s $filename, "Overwritten arrays of the same number of keys reuses space" );
+$db->{baz} = {};
+
+cmp_ok( $size, '==', -s $filename, "delete and rewrite reuses space" );
diff --git a/t/41_transaction_multilevel.t b/t/41_transaction_multilevel.t
new file mode 100644
index 0000000..6874dc4
--- /dev/null
+++ b/t/41_transaction_multilevel.t
@@ -0,0 +1,78 @@
+use strict;
+use Test::More tests => 33;
+use Test::Deep;
+use t::common qw( new_fh );
+
+use_ok( 'DBM::Deep' );
+
+my ($fh, $filename) = new_fh();
+my $db1 = DBM::Deep->new(
+    file => $filename,
+    locking => 1,
+    autoflush => 1,
+);
+
+my $db2 = DBM::Deep->new(
+    file => $filename,
+    locking => 1,
+    autoflush => 1,
+);
+
+$db1->{x} = { foo => 'y' };
+is( $db1->{x}{foo}, 'y', "Before transaction, DB1's X is Y" );
+is( $db2->{x}{foo}, 'y', "Before transaction, DB2's X is Y" );
+
+$db1->begin_work;
+
+    cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
+    cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
+
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( foo )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( foo )], "DB2->X keys correct" );
+
+    is( $db1->{x}{foo}, 'y', "After transaction, DB1's X is Y" );
+    is( $db2->{x}{foo}, 'y', "After transaction, DB2's X is Y" );
+
+    $db1->{x} = { bar => 30 };
+    ok( !exists $db1->{x}{foo}, "DB1: After reassignment of X, X->FOO is gone" );
+    is( $db2->{x}{foo}, 'y', "DB2: After reassignment of DB1 X, X is Y" );
+
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( bar )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( foo )], "DB2->X keys correct" );
+
+$db1->rollback;
+
+cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
+cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
+
+cmp_bag( [ keys %{$db1->{x}} ], [qw( foo )], "DB1->X keys correct" );
+cmp_bag( [ keys %{$db2->{x}} ], [qw( foo )], "DB2->X keys correct" );
+
+is( $db1->{x}{foo}, 'y', "Before transaction, DB1's X is Y" );
+is( $db2->{x}{foo}, 'y', "Before transaction, DB2's X is Y" );
+
+$db1->begin_work;
+
+    cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
+    cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
+
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( foo )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( foo )], "DB2->X keys correct" );
+
+    is( $db1->{x}{foo}, 'y', "After transaction, DB1's X is Y" );
+    is( $db2->{x}{foo}, 'y', "After transaction, DB2's X is Y" );
+
+    $db1->{x} = { bar => 30 };
+    ok( !exists $db1->{x}{foo}, "DB1: After reassignment of X, X->FOO is gone" );
+    is( $db2->{x}{foo}, 'y', "DB2: After reassignment of DB1 X, X is Y" );
+
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( bar )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( foo )], "DB2->X keys correct" );
+
+$db1->commit;
+
+cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
+cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
+
+cmp_bag( [ keys %{$db1->{x}} ], [qw( bar )], "DB1->X keys correct" );
+cmp_bag( [ keys %{$db2->{x}} ], [qw( bar )], "DB2->X keys correct" );