Added more stringent tests to the multilevel transactions and started the release...

diff --git a/Changes b/Changes
index 22535e0..66a9f4e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,15 @@
 Revision history for DBM::Deep.
 
+1.0007 Nov 15 12:00:00 2007 EST
+    - (This version is compatible with 1.0006)
+    - Fixed a number of Win32 issues (Reported by Steven Samelson - thank you!)
+        - Much thanks to Nigel Sandever and David Golden for their help
+        debugging the issues, particularly with DBM::Deep's usage of
+        File::Temp which removes a number of warnings.
+        - Autovivification now works on Win32. It turns out that when a
+        process takes a shared flock on a file, it's not allowed to write to
+        it under Win32, unlike *nix. This is probably a good catch.
+
 1.0006 Oct 01 23:15:00 2007 EDT
     - (This version is compatible with 1.0005)
     - Removed Clone and replaced it with a hand-written datastructure walker.

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index d34e675..54a2638 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -5,7 +5,7 @@ use 5.006_000;
 use strict;
 use warnings;
 
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
 
 use Fcntl qw( :flock );
 

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 6f78c0d..7522549 100644 (file)
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -5,7 +5,7 @@ use 5.006_000;
 use strict;
 use warnings;
 
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
 
 # This is to allow DBM::Deep::Array to handle negative indices on
 # its own. Otherwise, Perl would intercept the call to negative

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index fd6b9b7..4206e85 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -5,7 +5,7 @@ use 5.006_000;
 use strict;
 use warnings;
 
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
 
 use Scalar::Util ();
 

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 6f8e060..612c6eb 100644 (file)
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -5,7 +5,7 @@ use 5.006_000;
 use strict;
 use warnings;
 
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
 
 use Fcntl qw( :DEFAULT :flock :seek );
 

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 7bca7ce..c152b22 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -5,7 +5,7 @@ use 5.006_000;
 use strict;
 use warnings;
 
-our $VERSION = q(1.0006);
+our $VERSION = q(1.0007);
 
 use base 'DBM::Deep';
 

diff --git a/t/41_transaction_multilevel.t b/t/41_transaction_multilevel.t
index b8985e1..f06b2eb 100644 (file)
--- a/t/41_transaction_multilevel.t
+++ b/t/41_transaction_multilevel.t
@@ -1,5 +1,5 @@
 use strict;
-use Test::More tests => 33;
+use Test::More tests => 41;
 use Test::Deep;
 use t::common qw( new_fh );
 
@@ -23,64 +23,76 @@ my $db2 = DBM::Deep->new(
     num_txns  => 2,
 );
 
-$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->{x} = { xy => { foo => 'y' } };
+is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
+is( $db2->{x}{xy}{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" );
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "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" );
+    cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
+    cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );
 
-    $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" );
+    is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
+    is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's 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->{x} = { yz => { bar => 30 } };
+    ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" );
+    is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X is Y" );
+
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "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" );
+cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
+cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" );
+
+cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
+cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY 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" );
+is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" );
+is( $db2->{x}{xy}{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" );
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "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" );
+    cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" );
+    cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" );
 
-    $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" );
+    is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" );
+    is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's 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->{x} = { yz => { bar => 30 } };
+    ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" );
+    is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X->YZ is Y" );
+
+    cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
+    cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "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" );
+cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" );
+cmp_bag( [ keys %{$db2->{x}} ], [qw( yz )], "DB2->X keys correct" );
+
+cmp_bag( [ keys %{$db1->{x}{yz}} ], [qw( bar )], "DB1->X->XY keys correct" );
+cmp_bag( [ keys %{$db2->{x}{yz}} ], [qw( bar )], "DB2->X->XY keys correct" );
 
 $db1->_get_self->_storage->close( $db1->_get_self );
 $db2->_get_self->_storage->close( $db2->_get_self );