File Coverage

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

Criterion	Covered	Total	%
statement	103	104	99.0
branch	17	20	85.0
condition	1	2	50.0
subroutine	22	22	100.0
pod	6	10	60.0
total	149	158	94.3

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

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

use Scalar::Util qw/blessed reftype/;

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

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,
        stringify_got => 1,
    );
}

sub unlike_convert {
    my ($thing) = @_;
    return Test::Stream::Compare::Pattern->new(
        negate        => 1,
        stringify_got => 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;
}

sub isa_ok($;@) {
    my ($thing, @items) = @_;
    my $ctx = context();

    my $file = $ctx->debug->file;
    my $line = $ctx->debug->line;

    my $name = render_ref($thing);
    my $type = reftype($thing) || "";

    my @bad;

    for my $item (@items) {
        next if $item eq $type;
        my $bool;
        protect { eval qq/#line $line "$file"\n\$bool = \$thing->isa(\$item); 1/ };
        next if $bool;

        push @bad => $item;
    }

    $ctx->ok(
        !@bad,
        @items == 1 ? "$name\->isa('$items[0]')" : "$name\->isa(...)",
        [map { "Failed: $name\->isa('$_')" } @bad],
    );

    $ctx->release;

    return !@bad;
}

1;

__END__