From 21b05b4998158b30c25a571e10902dd2e2931e2d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C5=8Dan?= <koan.bot@atoomic.org>
Date: Sat, 7 Mar 2026 15:34:02 -0700
Subject: [PATCH] fix: replace cmp_ok() operator blocklist with allowlist

The previous %cmp_ok_bl blocklist only rejected 9 assignment operators
but allowed any other string through to the string eval on line 973,
where $type is interpolated unsanitized. Replace with %cmp_ok_al
allowlist of 23 valid Perl comparison operators, matching the canonical
set from Test2::Tools::ClassicCompare::%OPS.

Update tests to reflect the stricter validation:
- t/Legacy/cmp_ok.t: add test cases for +, -, * rejection
- t/Legacy/478-cmp_ok_hash.t: expect throw instead of syntax error

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
---
 lib/Test/Builder.pm        | 18 +++++++++++++++---
 t/Legacy/478-cmp_ok_hash.t | 33 ++++-----------------------------
 t/Legacy/cmp_ok.t          |  9 +++++----
 3 files changed, 24 insertions(+), 36 deletions(-)

diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm
index ff9bf115b..c6440be35 100644
--- a/lib/Test/Builder.pm
+++ b/lib/Test/Builder.pm
@@ -939,14 +939,26 @@ sub unlike {
 
 my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
 
-# Bad, these are not comparison operators. Should we include more?
-my %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "...");
+# Allowlist of valid Perl comparison operators.
+# Matches Test2::Tools::ClassicCompare::%OPS for consistency.
+my %cmp_ok_al = map { ( $_, 1 ) } (
+    # numeric
+    "<", "<=", ">", ">=", "==", "!=", "<=>",
+    # string
+    "eq", "ne", "gt", "lt", "ge", "le", "cmp", "=~", "!~",
+    # logic
+    "&&", "||", "xor", "or", "and", "//",
+    # bitwise
+    "&", "|",
+    # match
+    "~~",
+);
 
 sub cmp_ok {
     my( $self, $got, $type, $expect, $name ) = @_;
     my $ctx = $self->ctx;
 
-    if ($cmp_ok_bl{$type}) {
+    if (!$cmp_ok_al{$type}) {
         $ctx->throw("$type is not a valid comparison operator in cmp_ok()");
     }
 
diff --git a/t/Legacy/478-cmp_ok_hash.t b/t/Legacy/478-cmp_ok_hash.t
index 811835b9d..c0d70b097 100644
--- a/t/Legacy/478-cmp_ok_hash.t
+++ b/t/Legacy/478-cmp_ok_hash.t
@@ -8,34 +8,9 @@ my $got  = 0;
 
 cmp_ok($got, 'eq', $want, "Passes on correct comparison");
 
-my ($res, @ok, @diag, @warn);
-{
-    no warnings 'redefine';
-    local *Test::Builder::ok = sub {
-        my ($tb, $ok, $name) = @_;
-        push @ok => $ok;
-        return $ok;
-    };
-    local *Test::Builder::diag = sub {
-        my ($tb, @d) = @_;
-        push @diag => @d;
-    };
-    local $SIG{__WARN__} = sub {
-        push @warn => @_;
-    };
-    $res = cmp_ok($got, '#eq', $want, "You shall not pass!");
-}
-
-ok(!$res, "Did not pass");
-
-is(@ok, 1, "1 result");
-ok(!$ok[0], "result is false");
-
-# We only care that it mentions a syntax error.
-like(join("\n" => @diag), qr/syntax error at \(eval in cmp_ok\)/, "Syntax error");
-
-# We are not going to inspect the warning because it is not super predictable,
-# and changes with eval specifics.
-ok(@warn, "We got warnings");
+# Invalid operator '#eq' should be rejected by the allowlist
+my $threw = !eval { cmp_ok($got, '#eq', $want, "You shall not pass!"); 1 };
+ok($threw, "Invalid operator throws");
+like($@, qr/#eq is not a valid comparison operator in cmp_ok\(\)/, "Error message mentions invalid operator");
 
 done_testing;
diff --git a/t/Legacy/cmp_ok.t b/t/Legacy/cmp_ok.t
index 3f38e0e87..46ab131eb 100755
--- a/t/Legacy/cmp_ok.t
+++ b/t/Legacy/cmp_ok.t
@@ -67,9 +67,6 @@ my @Tests = (
     [1, '==', 2],
     ["a", "eq", "b"],
     ["a", "eq", "a"],
-    [1, "+", 1],
-    [1, "-", 1],
-
     [$cmp, '==', 42],
     [$cmp, 'eq', "foo"],
     [$ify, 'eq', "bar"],
@@ -77,8 +74,12 @@ my @Tests = (
 
     [$part, '!=', 0, 'expected: anything else'],
 
-    [1, "=", 0,  "= is not a valid comparison operator in cmp_ok()"],
+    # Operators rejected by allowlist
+    [1, "=",  0, "= is not a valid comparison operator in cmp_ok()"],
     [1, "+=", 0, "+= is not a valid comparison operator in cmp_ok()"],
+    [1, "+",  1, "+ is not a valid comparison operator in cmp_ok()"],
+    [1, "-",  1, "- is not a valid comparison operator in cmp_ok()"],
+    [1, "*",  1, "* is not a valid comparison operator in cmp_ok()"],
 );
 
 plan tests => scalar @Tests;