r13132@rob-kinyons-powerbook58: rob | 2006-05-14 20:27:47 -0400
rkinyon [Thu, 25 May 2006 18:21:32 +0000 (18:21 +0000)]
 Added/modified more files

MANIFEST
t/22_internal_copy.t
t/36_transaction_deep.t
t/38_transaction_add_item.t [new file with mode: 0644]
t/39_singletons.t [new file with mode: 0644]

index 3706a52..3899d58 100644 (file)
--- 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
index c2ed42a..9de69f4 100644 (file)
@@ -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();
index d0a3619..ca9f7a6 100644 (file)
@@ -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 (file)
index 0000000..0b2b8a8
--- /dev/null
@@ -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 (file)
index 0000000..0bf9d60
--- /dev/null
@@ -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" );