From: rkinyon@cpan.org <rkinyon@cpan.org>
Date: Tue, 30 Dec 2008 14:10:46 +0000 (+0000)
Subject: Fixed a bug in how deletions of entries in an auto-vivified hashref works.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c803879b22cf8a04429dda9ea84ead7e2ffa2fc2;p=dbsrgits%2FDBM-Deep.git

Fixed a bug in how deletions of entries in an auto-vivified hashref works.

git-svn-id: http://svn.ali.as/cpan/trunk/DBM-Deep@4794 88f4d9cd-8a04-0410-9d60-8f63309c3137
---

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index f712c0d..6a4a2c3 100644
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -480,7 +480,7 @@ sub STORE {
     ##
     my $self = shift->_get_self;
     my ($key, $value) = @_;
-    warn "STORE($self, $key, @{[defined$value?$value:'undef']})\n" if DEBUG;
+    warn "STORE($self, '$key', '@{[defined$value?$value:'undef']}')\n" if DEBUG;
 
     unless ( $self->_engine->storage->is_writable ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
@@ -494,7 +494,7 @@ sub STORE {
         $value = $self->_engine->storage->{filter_store_value}->( $value );
     }
 
-    $self->_engine->write_value( $self, $key, $value);
+    my $x = $self->_engine->write_value( $self, $key, $value);
 
     $self->unlock;
 
@@ -507,7 +507,7 @@ sub FETCH {
     ##
     my $self = shift->_get_self;
     my ($key) = @_;
-    warn "FETCH($self,$key)\n" if DEBUG;
+    warn "FETCH($self, '$key')\n" if DEBUG;
 
     $self->lock_shared;
 
@@ -528,7 +528,7 @@ sub DELETE {
     ##
     my $self = shift->_get_self;
     my ($key) = @_;
-    warn "DELETE($self,$key)\n" if DEBUG;
+    warn "DELETE($self, '$key')\n" if DEBUG;
 
     unless ( $self->_engine->storage->is_writable ) {
         $self->_throw_error( 'Cannot write to a readonly filehandle' );
@@ -556,7 +556,7 @@ sub EXISTS {
     ##
     my $self = shift->_get_self;
     my ($key) = @_;
-    warn "EXISTS($self,$key)\n" if DEBUG;
+    warn "EXISTS($self, '$key')\n" if DEBUG;
 
     $self->lock_shared;
 
diff --git a/lib/DBM/Deep/Engine/Sector/Reference.pm b/lib/DBM/Deep/Engine/Sector/Reference.pm
index 94dfaee..ff40670 100644
--- a/lib/DBM/Deep/Engine/Sector/Reference.pm
+++ b/lib/DBM/Deep/Engine/Sector/Reference.pm
@@ -163,10 +163,13 @@ sub delete_key {
     my $self = shift;
     my ($args) = @_;
 
-    # XXX What should happen if this fails?
+    # This can return nothing if we are deleting an entry in a hashref that was
+    # auto-vivified as part of the delete process. For example:
+    #     my $x = {};
+    #     delete $x->{foo}{bar};
     my $blist = $self->get_bucket_list({
         key_md5 => $args->{key_md5},
-    }) or DBM::Deep->_throw_error( "How did delete_key fail (no blist)?!" );
+    }) or return;
 
     # Save the location so that we can free the data
     my $location = $blist->get_data_location_for({
diff --git a/t/50_deletes.t b/t/50_deletes.t
index acc2178..0109cbb 100644
--- a/t/50_deletes.t
+++ b/t/50_deletes.t
@@ -1,13 +1,14 @@
+use 5.006_000;
 
 use strict;
+use warnings FATAL => 'all';
+
 use Test::More;
 
 use t::common qw( new_fh );
 
 my $max = 10;
 
-plan skip_all => "Need to work on this one later.";
-
 plan tests => $max + 1;
 
 use_ok( 'DBM::Deep' );
@@ -15,13 +16,13 @@ use_ok( 'DBM::Deep' );
 my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( file => $filename, fh => $fh, );
 
-my $x = 0;
-while( $x < $max ) {
+my $x = 1;
+while( $x <= $max ) {
     eval {
         delete $db->{borked}{test};
         $db->{borked}{test} = 1;
     };
 
-    ok(!$@, 'No eval failures');
+    ok(!$@, "No eval failure after ${x}th iteration");
     $x++;
 }