—

              
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__
HideShow 141 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
Test::Stream::Plugin::Classic - Classing (Test::More) style is and is_deeply.
=head1 DEPRECATED
B<This distribution is deprecated> in favor of L<Test2>, L<Test2::Suite>, and
L<Test2::Workflow>.
See L<Test::Stream::Manual::ToTest2> for a conversion guide.
=head1 DESCRIPTION
This provides C<is()> and C<is_deeply()> functions that behave close to the way
they did in L<Test::More>, unlike the L<Test::Stream::Plugin::Compare> plugin
which has enhanced them (or ruined them, depending on who you ask).
=head1 SYNOPSIS
    use Test::Stream 'Classic';
    is($got, $expect, "these are the same when stringified");
    isnt($got, $unexpect, "these are not the same when stringified");
    like($got, qr/.../, "'got' matches the pattern");
    unlike($got, qr/.../, "'got' does not match the pattern");
    is_deeply($got, $expect, "These structures are same when checked deeply");
=head1 EXPORTS
=over 4
=item $bool = is($got, $expect)
=item $bool = is($got, $expect, $name)
=item $bool = is($got, $expect, $name, @diag)
This does a string comparison of the 2 arguments. If the 2 arguments are the
same after stringification the test passes. The test will also pas sif both
arguments are undef.
The test C<$name> is optional.
The test C<@diag> is optional, it is extra diagnostics messages that will be
displayed if the test fails. The diagnostics are ignored if the test passes.
It is important to note that this tool considers C<"1"> and C<"1.0"> to not be
equal as it uses a string comparison.
See L<Test::Stream::Plugin::Compare> if you want a C<is()> function that tries
to be smarter for you.
=item $bool = isnt($got, $dont_expect)
=item $bool = isnt($got, $dont_expect, $name)
=item $bool = isnt($got, $dont_expect, $name, @diag)
This is the inverse of C<is()>, it passes when the strings are not the same.
=item $bool = like($got, $pattern)
=item $bool = like($got, $pattern, $name)
=item $bool = like($got, $pattern, $name, @diag)
Check if C<$got> matches the specified pattern. Will fail if it does not match.
The test C<$name> is optional.
The test C<@diag> is optional, it is extra diagnostics messages that will be
displayed if the test fails. The diagnostics are ignored if the test passes.
=item $bool = unlike($got, $pattern)
=item $bool = unlike($got, $pattern, $name)
=item $bool = unlike($got, $pattern, $name, @diag)
This is the inverse of C<like()>. This will fail if C<$got> matches
C<$pattern>.
=item $bool = is_deeply($got, $expect)
=item $bool = is_deeply($got, $expect, $name)
=item $bool = is_deeply($got, $expect, $name, @diag)
This does a deep check, it compares the structures in C<$got> with those in
C<$expect>. It will recurse into hashrefs, arrayrefs, and scalar refs. All
other values will be stringified and compared as strings. It is important to
note that this tool considers C<"1"> and C<"1.0"> to not be equal as it uses a
string comparison.
This is the same as C<Test::Stream::Plugin::Compare::is()>.
=item $bool = isa_ok($thing, @types)
Check if C<< $thing->isa($type) >> for each type. You can also check if a
reference is a specific ref type.
=back
=head1 SOURCE
The source code repository for Test::Stream can be found at
F<http://github.com/Test-More/Test-Stream/>.
=head1 MAINTAINERS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 AUTHORS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 COPYRIGHT
Copyright 2015 Chad Granum E<lt>exodist7@gmail.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F<http://dev.perl.org/licenses/>
=cut