Fix for [RT #32462]: avoid leading temp files around

[dbsrgits/DBM-Deep.git] / t / 04_array.t

diff --git a/t/04_array.t b/t/04_array.t
index 3bfc933..a75c349 100644 (file)
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -2,7 +2,7 @@
 # DBM::Deep Test
 ##
 use strict;
-use Test::More tests => 128;
+use Test::More tests => 130;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -19,13 +19,10 @@ my $db = DBM::Deep->new(
 # basic put/get/push
 ##
 $db->[0] = "elem1";
-#$db->push( "elem2" );
-#$db->put(2, "elem3");
-#$db->store(3, "elem4");
-warn $db->_engine->_dump_file;
+$db->push( "elem2" );
+$db->put(2, "elem3");
+$db->store(3, "elem4");
 $db->unshift("elem0");
-warn $db->_engine->_dump_file;
-__END__
 
 is( $db->[0], 'elem0', "Array get for shift works" );
 is( $db->[1], 'elem1', "Array get for array set works" );
@@ -279,3 +276,19 @@ throws_ok {
     is( $db->[4][3][1], 2, "Right arrayref there" );
     is( $db->[5]{foo}, 1, "Right hashref there" );
 }
+
+{ # 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 $a = [];
+    my $tmp = $a;
+    for(1..100) {
+        ($tmp) = @$tmp = [];
+    }
+    ok eval {
+        $db->{""} = $a;
+    }, 'deep recursion in array assignment' or diag $@;
+    is $w, undef, 'no warnings with deep recursion in array assignment';
+}