Avoid infinite loop in _find_code_refs.

Patch by Yasushi Nakajima (rt.cpan.org #61262)

2 files changed, 17 insertions, 2 deletions

diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
index bca4dfe8e6..57416a8d56 100644
--- a/dist/Safe/Safe.pm
+++ b/dist/Safe/Safe.pm
@@ -2,7 +2,7 @@ package Safe;
 
 use 5.003_11;
 use strict;
-use Scalar::Util qw(reftype);
+use Scalar::Util qw(reftype refaddr);
 
 $Safe::VERSION = "2.27";
 
@@ -362,10 +362,12 @@ sub reval {
     return (wantarray) ? @subret : $subret[0];
 }
 
+my %OID;
 
 sub wrap_code_refs_within {
     my $obj = shift;
 
+    %OID = ();
     $obj->_find_code_refs('wrap_code_ref', @_);
 }
 
@@ -377,6 +379,10 @@ sub _find_code_refs {
     for my $item (@_) {
         my $reftype = $item && reftype $item
             or next;
+
+        # skip references already seen
+        next if ++$OID{refaddr $item} > 1;
+
         if ($reftype eq 'ARRAY') {
             $obj->_find_code_refs($visitor, @$item);
         }
diff --git a/dist/Safe/t/safewrap.t b/dist/Safe/t/safewrap.t
index 27166f8bb5..b99f4164dd 100644
--- a/dist/Safe/t/safewrap.t
+++ b/dist/Safe/t/safewrap.t
@@ -11,7 +11,7 @@ BEGIN {
 
 use strict;
 use Safe 1.00;
-use Test::More tests => 9;
+use Test::More tests => 10;
 
 my $safe = Safe->new('PLPerl');
 $safe->permit_only(qw(:default sort));
@@ -37,3 +37,12 @@ my $sub1w2 = $args[1][0][1]{sub};
 isnt $sub1w2, $sub1;
 is eval { $sub1w2->() }, undef;
 like $@, qr/eval .* trapped by operation mask/;
+
+# Avoid infinite recursion when looking for coderefs
+my $r = $safe->reval(<<'END');
+%a = ();
+%b = (a => \%a);
+$a{b} = \%b;
+42;
+END
+is($r, 42);