view release on metacpan or  search on metacpan

lib/Test2/Tools/ClassicCompare.pm  view on Meta::CPAN

package Test2::Tools::ClassicCompare;
use strict;
use warnings;

our $VERSION = '1.302222';

our @EXPORT = qw/is is_deeply isnt like unlike cmp_ok/;
use base 'Exporter';

use Carp qw/carp/;
use Scalar::Util qw/reftype/;

use Test2::API qw/context/;
use Test2::Compare qw/compare strict_convert/;
use Test2::Util::Ref qw/rtype render_ref/;
use Test2::Util::Table qw/table/;

use Test2::Compare::Array();
use Test2::Compare::Bag();
use Test2::Compare::Custom();
use Test2::Compare::Event();
use Test2::Compare::Hash();
use Test2::Compare::Meta();
use Test2::Compare::Number();
use Test2::Compare::Object();
use Test2::Compare::OrderedSubset();
use Test2::Compare::Pattern();
use Test2::Compare::Ref();
use Test2::Compare::Regex();
use Test2::Compare::Scalar();
use Test2::Compare::Set();
use Test2::Compare::String();
use Test2::Compare::Undef();
use Test2::Compare::Wildcard();

sub is($$;$@) {
    my ($got, $exp, $name, @diag) = @_;
    my $ctx = context();

    my @caller = caller;

    my $delta = compare($got, $exp, \&is_convert);

    if ($delta) {
        $ctx->fail($name, $delta->diag, @diag);
    }
    else {
        $ctx->ok(1, $name);
    }

    $ctx->release;
    return !$delta;
}

sub isnt($$;$@) {
    my ($got, $exp, $name, @diag) = @_;
    my $ctx = context();

    my @caller = caller;

    my $delta = compare($got, $exp, \&isnt_convert);

    if ($delta) {
        $ctx->fail($name, $delta->diag, @diag);
    }
    else {
        $ctx->ok(1, $name);
    }

    $ctx->release;
    return !$delta;
}

sub is_convert {
    my ($thing) = @_;
    return Test2::Compare::Undef->new()
        unless defined $thing;
    return Test2::Compare::String->new(input => $thing);
}

sub isnt_convert {
    my ($thing) = @_;
    return Test2::Compare::Undef->new()
        unless defined $thing;
    my $str = Test2::Compare::String->new(input => $thing, negate => 1);
}

sub like($$;$@) {
    my ($got, $exp, $name, @diag) = @_;
    my $ctx = context();

    my $delta = compare($got, $exp, \&like_convert);

    if ($delta) {
        $ctx->fail($name, $delta->diag, @diag);
    }