Custom comparison operators cannot be used in Test2::Tools::ClassicCompare::cmp_ok

[eserte]

There are different possibilities to define custom comparison operators in Perl, however, it seems that Test2's cmp_ok cannot use these, even if the operator is added to %Test2::Tools::ClassicCompare::OPS.

One type of custom operators may be defined with the help of Sub::Infix, for example |M| in match::simple.

The following test script using |M| fails:

use strict;
use Test2::V0 -no_srand=>1;
use match::simple;

$Test2::Tools::ClassicCompare::OPS{'|M|'} = 1;

cmp_ok "bar", "|M|", ["foo","bar","baz"];
cmp_ok "bla", "|M|", ["foo","bar","baz"];

done_testing;

The error message says something like

Bareword "M" not allowed while "strict subs" in use at (eval in cmp_ok) 1.t line 7.

In newer perl versions (5.37.7+) it is possible to define real custom infix operators, for example eqr in Syntax::Operator::Eqr.

The following test script fails, with a similar error like in the former script:

use v5.38;
use Syntax::Operator::Eqr;
use Test2::V0 -no_srand=>1;

$Test2::Tools::ClassicCompare::OPS{'eqr'} = 1;
#$Test2::Tools::ClassicCompare::USE{'eqr'} = 'Syntax::Operator::Eqr'; # will be explained later

cmp_ok "bar", "eqr", "bar";
cmp_ok "bla", "eqr", qr/^bla/;
cmp_ok "bla", "eqr", "foo";
cmp_ok "bla", "eqr", qr/^foo/;

done_testing;

Both types of operators are caused by different problems and may be workarounded by the following patch:

diff --git i/lib/Test2/Tools/ClassicCompare.pm w/lib/Test2/Tools/ClassicCompare.pm
index 8a64ad33..48193e58 100644
--- i/lib/Test2/Tools/ClassicCompare.pm
+++ w/lib/Test2/Tools/ClassicCompare.pm
@@ -215,6 +215,8 @@ our %OPS = (
 
     '~~' => 'match',
 );
+our %USE;
+
 sub cmp_ok($$$;$@) {
     my ($got, $op, $exp, $name, @diag) = @_;
 
@@ -229,11 +231,13 @@ sub cmp_ok($$$;$@) {
         carp "operator '$op' is not supported (you can add it to %Test2::Tools::ClassicCompare::OPS)";
         $type = 'unsupported';
     }
+    my $use_line = exists $USE{$op} ? "\nuse $USE{$op};" : "";
 
     local ($@, $!, $SIG{__DIE__});
 
     my $test;
     my $lived = eval <<"    EOT";
+package $pkg;$use_line
 #line $line "(eval in cmp_ok) $file"
 \$test = (\$got $op \$exp);
 1;

For Sub::Infix operators it's sufficient to define the package to be one of the caller.

Custom infix operators seem to be valid only in a lexical block, so defining the package is not sufficient. A possible solution would be to use the required module, which needs to be added to a new global %Test2::Tools::ClassicCompare::USE.

Another way to support at least Sub::Infix operators would be the definition of a Test2::Compare::Custom check like this:

sub cmp_op_ok ($$) {
    my($pack) = caller;
    my $op = shift;
    my $name = shift;
    my $code = q<package >.$pack.q<; sub($$){ $_[0] >.$op.q< $_[1] }>;
    my $sub = eval $code;
    die "Compiling '$code' failed: $@" if !$sub;
    require Data::Dumper;
    Test2::Compare::Custom->new(
        name => do {
            local $Data::Dumper::Terse = 1;
            local $Data::Dumper::Indent = 0;
            local $Data::Dumper::Deparse = 1;
            my $s = Data::Dumper::Dumper($name);
            $s =~ s/^\$VAR1 =//;
            my $maxlen = 50;
            if (length($s)>$maxlen) {
                $s = substr($s,0,$maxlen/2-2).'...'.substr($s,-($maxlen/2-2));
            }
            $s;
        },
        operator => $op,
        code => sub {
            my %args = @_;
            return $sub->($args{got}, $name);
        },
    );
}

This could be used like this:

is($got, cmp_op_ok('|M|', $expected), "test name");

Custom infix operators would still need to use the required module (not done here).

I am not actually asking to apply the patch above. Maybe documenting the current limitations would be a good first step. Maybe someone else finds better ways to support custom operators with cmp_ok.

(BTW, cmp_ok in Test::More also cannot cope with custom operators)