Fix fatal recursion warnings (plus tests)

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 6a4a2c3..8f4df39 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -4,6 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
 our $VERSION = q(1.0014);
 

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 5521477..173f869 100644 (file)
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -4,6 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings;
+no warnings 'recursion';
 
 our $VERSION = q(1.0013);
 

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 49a075c..8f6a8f8 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -4,6 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
 # Never import symbols into our namespace. We are a class, not a library.
 # -RobK, 2008-05-27

diff --git a/lib/DBM/Deep/Engine/Sector/Scalar.pm b/lib/DBM/Deep/Engine/Sector/Scalar.pm
index 7dfb1b9..f045f51 100644 (file)
--- a/lib/DBM/Deep/Engine/Sector/Scalar.pm
+++ b/lib/DBM/Deep/Engine/Sector/Scalar.pm
@@ -4,6 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
 use base qw( DBM::Deep::Engine::Sector::Data );
 

diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm
index 50dd19d..6b43d96 100644 (file)
--- a/lib/DBM/Deep/Hash.pm
+++ b/lib/DBM/Deep/Hash.pm
@@ -4,6 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
 use base 'DBM::Deep';
 

diff --git a/t/02_hash.t b/t/02_hash.t
index 6e9972a..ee3b409 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 => 51;
 use Test::Exception;
 use t::common qw( new_fh );
 
@@ -143,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' );

diff --git a/t/04_array.t b/t/04_array.t
index 24b52ec..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 );
 
@@ -276,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';
+}

diff --git a/t/29_largedata.t b/t/29_largedata.t
index 70d67fa..16a9b32 100644 (file)
--- a/t/29_largedata.t
+++ b/t/29_largedata.t
@@ -15,10 +15,10 @@ my $db = DBM::Deep->new(
 ##
 # large keys
 ##
-my $val1 = "a" x 1000;
+my $val1 = "a" x 6000;
 
 $db->{foo} = $val1;
-is( $db->{foo}, $val1, "1000 char value stored and retrieved" );
+is( $db->{foo}, $val1, "6000 char value stored and retrieved" );
 
 delete $db->{foo};
 my $size = -s $filename;