xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/t/Legacy/cmp_ok.t (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5
6use lib 't/lib';
7
8require Test::Simple::Catch;
9my($out, $err) = Test::Simple::Catch::caught();
10local $ENV{HARNESS_ACTIVE} = 0;
11
12require Test::Builder;
13my $TB = Test::Builder->create;
14$TB->level(0);
15
16sub try_cmp_ok {
17    my($left, $cmp, $right, $error) = @_;
18
19    my %expect;
20    if( $error ) {
21        $expect{ok} = 0;
22        $expect{error} = $error;
23    }
24    else {
25        $expect{ok}    = eval "\$left $cmp \$right";
26        $expect{error} = $@;
27        $expect{error} =~ s/ at .*\n?//;
28    }
29
30    local $Test::Builder::Level = $Test::Builder::Level + 1;
31
32    my $ok;
33    eval { $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); };
34
35    $TB->is_num(!!$ok, !!$expect{ok}, "  right return");
36
37    my $diag = $err->read;
38
39    if ($@) {
40        $diag = $@;
41        $diag =~ s/ at .*\n?//;
42    }
43
44    if( !$ok and $expect{error} ) {
45        $diag =~ s/^# //mg;
46        $TB->like( $diag, qr/\Q$expect{error}\E/, "  expected error" );
47    }
48    elsif( $ok ) {
49        $TB->is_eq( $diag, '', "  passed without diagnostic" );
50    }
51    else {
52        $TB->ok(1, "  failed without diagnostic");
53    }
54}
55
56
57use Test::More;
58Test::More->builder->no_ending(1);
59
60require MyOverload;
61my $cmp = Overloaded::Compare->new("foo", 42);
62my $ify = Overloaded::Ify->new("bar", 23);
63my $part = Overloaded::Partial->new('baz', 0);
64
65my @Tests = (
66    [1, '==', 1],
67    [1, '==', 2],
68    ["a", "eq", "b"],
69    ["a", "eq", "a"],
70    [1, "+", 1],
71    [1, "-", 1],
72
73    [$cmp, '==', 42],
74    [$cmp, 'eq', "foo"],
75    [$ify, 'eq', "bar"],
76    [$ify, "==", 23],
77
78    [$part, '!=', 0, 'expected: anything else'],
79
80    [1, "=", 0,  "= is not a valid comparison operator in cmp_ok()"],
81    [1, "+=", 0, "+= is not a valid comparison operator in cmp_ok()"],
82);
83
84plan tests => scalar @Tests;
85$TB->plan(tests => @Tests * 2);
86
87for my $test (@Tests) {
88    try_cmp_ok(@$test);
89}
90