From a49f733e2a1280cbc4224d590df69dda59ff7a9c Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Tue, 14 Jan 2025 22:53:24 +0100
Subject: [PATCH] avoid closing over values in string eval when comparing
 values

When comparing values using Test::Builder::cmp_ok, a string eval is
used to match the caller location, and to inject an arbitrary comparison
op. When used with Devel::Cover, the string eval may close over any
variables used in it, and maintain them for the lifetime of the program.

Instead of comparing the values directly in the string eval, generate an
anonymous sub that will perform the comparison, and call it in a block
eval.

This is a reoccurrance of a previous problem that was fixed with
4fe707c2dc3fe4e80767be33ce41a2a65d082574. Some combination of perl or
module updates has brought back the issue. While there was a test
included with the bug, it only fails when run with Devel::Cover, which
isn't done during the automated or release testing.
---
 lib/Test/Builder.pm | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm
index c0fb76598..31739f931 100644
--- a/lib/Test/Builder.pm
+++ b/lib/Test/Builder.pm
@@ -963,13 +963,23 @@ sub cmp_ok {
         # over it, which can lead to issues with Devel::Cover
         my $bits_code = defined $warning_bits ? qq["\Q$warning_bits\E"] : 'undef';
 
-        # This is so that warnings come out at the caller's level
+        # Make sure warnings and location matches the caller. Can't do the
+        # comparison directly in the eval, as closing over variables can
+        # capture them forever when running with Devel::Cover.
+        my $check;
         $succ = eval qq[
 BEGIN {\${^WARNING_BITS} = $bits_code};
 #line $line "(eval in cmp_ok) $file"
-\$test = (\$got $type \$expect);
+\$check = sub { \$_[0] $type \$_[1] };
 1;
 ];
+
+        if ($succ) {
+            $succ = eval {
+                $test = $check->($got, $expect);
+                1;
+            };
+        }
         $error = $@;
     }
     local $Level = $Level + 1;