Remove temporary workaround for clear() and "0" key bug

[dbsrgits/DBM-Deep.git] / t / 02_hash.t

diff --git a/t/02_hash.t b/t/02_hash.t
index 4ad5d92..c6646c1 100644 (file)
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 49;
+use Test::More tests => 53;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -27,15 +27,15 @@ is( $db->get("key2"), undef, "get() works with put()" );
 is( $db->fetch("key2"), undef, "... fetch() works with put()" );
 is( $db->{key2}, undef, "... and hash-access also works" );
 
-$db->store( "key3", "value3" );
-is( $db->get("key3"), "value3", "get() works with store()" );
-is( $db->fetch("key3"), "value3", "... fetch() works with put()" );
-is( $db->{key3}, 'value3', "... and hash-access also works" );
+$db->store( "0", "value3" );
+is( $db->get("0"), "value3", "get() works with store()" );
+is( $db->fetch("0"), "value3", "... fetch() works with put()" );
+is( $db->{0}, 'value3', "... and hash-access also works" );
 
 # Verify that the keyval pairs are still correct.
 is( $db->{key1}, "value1", "Key1 is still correct" );
 is( $db->{key2}, undef, "Key2 is still correct" );
-is( $db->{key3}, 'value3', "Key3 is still correct" );
+is( $db->{0}, 'value3', "Key3 is still correct" );
 
 ok( $db->exists("key1"), "exists() function works" );
 ok( exists $db->{key2}, "exists() works against tied hash" );
@@ -45,7 +45,6 @@ is( $db->{key4}, undef, "Autovivified key4" );
 ok( exists $db->{key4}, "Autovivified key4 now exists" );
 
 delete $db->{key4};
-
 ok( !exists $db->{key4}, "And key4 doesn't exists anymore" );
 
 # Keys will be done via an iterator that keeps a breadcrumb trail of the last
@@ -69,25 +68,25 @@ while ( my ($key, $value) = each %$db ) {
 
 is( $temphash->{key1}, 'value1', "First key copied successfully using tied interface" );
 is( $temphash->{key2}, undef, "Second key copied successfully" );
-is( $temphash->{key3}, 'value3', "Third key copied successfully" );
+is( $temphash->{0}, 'value3', "Third key copied successfully" );
 
 $temphash = {};
 my $key = $db->first_key();
-while ($key) {
+while (defined $key) {
     $temphash->{$key} = $db->get($key);
     $key = $db->next_key($key);
 }
 
 is( $temphash->{key1}, 'value1', "First key copied successfully using OO interface" );
 is( $temphash->{key2}, undef, "Second key copied successfully" );
-is( $temphash->{key3}, 'value3', "Third key copied successfully" );
+is( $temphash->{0}, 'value3', "Third key copied successfully" );
 
 ##
 # delete keys
 ##
 is( delete $db->{key2}, undef, "delete through tied inteface works" );
 is( $db->delete("key1"), 'value1', "delete through OO inteface works" );
-is( $db->{key3}, 'value3', "The other key is still there" );
+is( $db->{0}, 'value3', "The other key is still there" );
 ok( !exists $db->{key1}, "key1 doesn't exist" );
 ok( !exists $db->{key2}, "key2 doesn't exist" );
 
@@ -144,6 +143,24 @@ ok(
     ,"keys() still works if you replace long values with shorter ones"
 );
 
+# Make sure we do not trigger a deep recursion warning [RT #53575]
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w = shift };
+    my ($fh, $filename) = new_fh();
+    my $db = DBM::Deep->new( file => $filename, fh => $fh, );
+    my $h = {};
+    my $tmp = $h;
+    for(1..100) {
+        %$tmp = ("" => {});
+        $tmp = $$tmp{""};
+    }
+    ok eval {
+        $db->{""} = $h;
+    }, 'deep recursion in hash assignment' or diag $@;
+    is $w, undef, 'no warnings with deep recursion in hash assignment';
+}
+
 # Test autovivification
 $db->{unknown}{bar} = 1;
 ok( $db->{unknown}, 'Autovivified hash exists' );
@@ -182,3 +199,22 @@ throws_ok {
     $db->exists(undef);
 } qr/Cannot use an undefined hash key/, "EXISTS fails on an undefined key";
 
+{
+    # RT# 50541 (reported by Peter Scott)
+    # clear() leaves one key unless there's only one
+    my ($fh, $filename) = new_fh();
+    my $db = DBM::Deep->new(
+        file => $filename,
+        fh => $fh,
+    );
+
+    $db->{block} = { };
+    $db->{critical} = { };
+    $db->{minor} = { };
+
+    cmp_ok( scalar(keys( %$db )), '==', 3, "Have 3 keys" );
+
+    $db->clear;
+
+    cmp_ok( scalar(keys( %$db )), '==', 0, "clear clears everything" );
+}