view release on metacpan or  search on metacpan

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

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

use Scalar::Util qw/blessed/;

use Test2::Util qw/try/;
use Test2::API qw/context run_subtest test2_stack/;

use Test2::Hub::Interceptor();
use Test2::Hub::Interceptor::Terminator();

our $VERSION = '1.302222';

BEGIN { require Exporter; our @ISA = qw(Exporter) }
our @EXPORT = qw{
    ok is isnt like unlike is_deeply diag note skip_all todo plan done_testing
    warnings exception tests capture
};

sub ok($;$@) {
    my ($bool, $name, @diag) = @_;
    my $ctx = context();

    return $ctx->pass_and_release($name) if $bool;
    return $ctx->fail_and_release($name, @diag);
}

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

    my $bool;
    if (defined($got) && defined($want)) {
        $bool = "$got" eq "$want";
    }
    elsif (defined($got) xor defined($want)) {
        $bool = 0;
    }
    else {    # Both are undef
        $bool = 1;
    }

    return $ctx->pass_and_release($name) if $bool;

    $got  = '*NOT DEFINED*' unless defined $got;
    $want = '*NOT DEFINED*' unless defined $want;
    unshift @diag => (
        "GOT:      $got",
        "EXPECTED: $want",
    );

    return $ctx->fail_and_release($name, @diag);
}

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

    my $bool;
    if (defined($got) && defined($want)) {
        $bool = "$got" ne "$want";
    }
    elsif (defined($got) xor defined($want)) {
        $bool = 1;
    }
    else {    # Both are undef
        $bool = 0;
    }

    return $ctx->pass_and_release($name) if $bool;

    unshift @diag => "Strings are the same (they should not be)"
        unless $bool;

    return $ctx->fail_and_release($name, @diag);
}

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

    my $bool;
    if (defined($thing)) {
        $bool = "$thing" =~ $pattern;
        unshift @diag => (
            "Value: $thing",
            "Does not match: $pattern"
        ) unless $bool;