From: rkinyon Date: Thu, 25 May 2006 18:21:32 +0000 (+0000) Subject: r13132@rob-kinyons-powerbook58: rob | 2006-05-14 20:27:47 -0400 X-Git-Tag: 0-99_03~33 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=867a26a009df91194ea62a07bdd0f34e0241ab66;p=dbsrgits%2FDBM-Deep.git r13132@rob-kinyons-powerbook58: rob | 2006-05-14 20:27:47 -0400 Added/modified more files --- diff --git a/MANIFEST b/MANIFEST index 3706a52..3899d58 100644 --- a/MANIFEST +++ b/MANIFEST @@ -48,3 +48,6 @@ t/33_transactions.t t/34_transaction_arrays.t t/35_transaction_multiple.t t/36_transaction_deep.t +t/37_delete_edge_cases.t +t/38_transaction_add_item.t +t/39_singletons.t diff --git a/t/22_internal_copy.t b/t/22_internal_copy.t index c2ed42a..9de69f4 100644 --- a/t/22_internal_copy.t +++ b/t/22_internal_copy.t @@ -45,7 +45,6 @@ is( scalar(keys %{$db->{hash1}}), 1, "... and only 1 key in the original" ); $db->{copy} = $db->{hash2}; is( $db->{copy}{subkey3}, 'subvalue3', "After the second copy, we're still good" ); - my $max_keys = 1000; my ($fh2, $filename2) = new_fh(); diff --git a/t/36_transaction_deep.t b/t/36_transaction_deep.t index d0a3619..ca9f7a6 100644 --- a/t/36_transaction_deep.t +++ b/t/36_transaction_deep.t @@ -13,19 +13,19 @@ my $db1 = DBM::Deep->new( ); my $x_outer = { a => 'b' }; -my $x_inner = { a => 'c' };; +my $x_inner = { a => 'c' }; $db1->{x} = $x_outer; -is( $db1->{x}{a}, 'b', "We're looking at the right value from outer" ); +is( $db1->{x}{a}, 'b', "BEFORE: We're looking at the right value from outer" ); $db1->begin_work; $db1->{x} = $x_inner; - is( $db1->{x}{a}, 'c', "We're looking at the right value from inner" ); - is( $x_outer->{a}, 'c', "We're looking at the right value from outer" ); + is( $db1->{x}{a}, 'c', "WITHIN: We're looking at the right value from inner" ); + is( $x_outer->{a}, 'c', "WITHIN: We're looking at the right value from outer" ); $db1->commit; -is( $db1->{x}{a}, 'c', "Commit means x_inner is still correct" ); -is( $x_outer->{a}, 'c', "outer made the move" ); -is( $x_inner->{a}, 'c', "inner is still good" ); +is( $db1->{x}{a}, 'c', "AFTER: Commit means x_inner is still correct" ); +is( $x_outer->{a}, 'c', "AFTER: outer made the move" ); +is( $x_inner->{a}, 'c', "AFTER: inner made the move" ); diff --git a/t/38_transaction_add_item.t b/t/38_transaction_add_item.t new file mode 100644 index 0000000..0b2b8a8 --- /dev/null +++ b/t/38_transaction_add_item.t @@ -0,0 +1,61 @@ +use strict; +use Test::More tests => 9; +use Test::Deep; +use t::common qw( new_fh ); + +use_ok( 'DBM::Deep' ); + +my ($fh, $filename) = new_fh(); +my $db = DBM::Deep->new( + file => $filename, + locking => 1, + autoflush => 1, +); + +{ + my $obj = bless { + foo => 5, + }, 'Foo'; + + cmp_ok( $obj->{foo}, '==', 5 ); + ok( !exists $obj->{bar} ); + + $db->begin_work; + + $db->{foo} = $obj; + $db->{foo}{bar} = 1; + + cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" ); + cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" ); + + $db->rollback; + + cmp_ok( $obj->{foo}, '==', 5 ); + ok( !exists $obj->{bar}, "bar doesn't exist" ); + ok( !tied(%$obj), "And it's not tied" ); + + ok( !exists $db->{foo}, "The transaction inside the DB works" ); +} + +__END__ +{ + my $obj = bless { + foo => 5, + }, 'Foo'; + + cmp_ok( $obj->{foo}, '==', 5 ); + ok( !exists $obj->{bar} ); + + $db->begin_work; + + $db->{foo} = $obj; + $db->{foo}{bar} = 1; + + cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" ); + cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" ); + + $db->commit; + + cmp_ok( $obj->{foo}, '==', 5 ); + ok( !exists $obj->{bar} ); +} diff --git a/t/39_singletons.t b/t/39_singletons.t new file mode 100644 index 0000000..0bf9d60 --- /dev/null +++ b/t/39_singletons.t @@ -0,0 +1,21 @@ +use strict; +use Test::More tests => 2; +use Test::Deep; +use t::common qw( new_fh ); + +use_ok( 'DBM::Deep' ); + +my ($fh, $filename) = new_fh(); +my $db = DBM::Deep->new( + file => $filename, + locking => 1, + autoflush => 1, +); + +$db->{foo} = { a => 'b' }; +my $x = $db->{foo}; +my $y = $db->{foo}; + +print "$x -> $y\n"; + +is( $x, $y, "The references are the same" );