File Coverage

blib/lib/Test/Stream/Plugin/Classic.pm

Criterion	Covered	Total	%
statement	85	86	98.8
branch	12	14	85.7
condition			n/a
subroutine	20	20	100.0
pod	5	9	55.5
total	122	129	94.5

package Test::Stream::Plugin::Classic;
use strict;
use warnings;

use Test::Stream::Exporter;
default_exports qw/is is_deeply isnt like unlike/;
no Test::Stream::Exporter;

use Scalar::Util qw/blessed/;

use Test::Stream::Compare qw/-all/;
use Test::Stream::Context qw/context/;
use Test::Stream::Util qw/rtype/;

use Test::Stream::Compare::String;
use Test::Stream::Compare::Pattern;

use Test::Stream::Plugin::Compare();

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

    my @caller = caller;

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

    if ($delta) {
        $ctx->ok(0, $name, [$delta->table, @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->ok(0, $name, [$delta->table, @diag]);
    }
    else {
        $ctx->ok(1, $name);
    }

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

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

sub isnt_convert {
    my ($thing) = @_;
    return Test::Stream::Compare::Undef->new()
        unless defined $thing;
    my $str = Test::Stream::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->ok(0, $name, [$delta->table, @diag]);
    }
    else {
        $ctx->ok(1, $name);
    }

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

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

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

    if ($delta) {
        $ctx->ok(0, $name, [$delta->table, @diag]);
    }
    else {
        $ctx->ok(1, $name);
    }

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

sub like_convert {
    my ($thing) = @_;
    return Test::Stream::Compare::Pattern->new(
        pattern => $thing,
    );
}

sub unlike_convert {
    my ($thing) = @_;
    return Test::Stream::Compare::Pattern->new(
        negate  => 1,
        pattern => $thing,
    );
}

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

    my @caller = caller;

    my $delta = compare($got, $exp, \&Test::Stream::Plugin::Compare::strict_convert);

    if ($delta) {
        $ctx->ok(0, $name, [$delta->table, @diag]);
    }
    else {
        $ctx->ok(1, $name);
    }

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

1;

__END__