view release on metacpan or  search on metacpan

t/test.pl  view on Meta::CPAN

sub ok {
    my ($ok, $name) = @_;

    lock($TEST);
    my $id = $TEST++;

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

    return ($ok);
}

sub is
{
    my ($got, $expected, $name) = @_;

    lock($TEST);
    my $id = $TEST++;

    my $ok = ("$got" eq "$expected");

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print("#      got: $got\n");
        print("# expected: $expected\n");
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

    return ($ok);
}

sub like
{

t/test.pl  view on Meta::CPAN

    lock($TEST);
    my $id = $TEST++;

    my $ok = "$got" =~ $like;

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print("#           got: $got\n");
        print("# doesn't match: $like\n");
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

    return ($ok);
}

sub is_deeply
{

t/test.pl  view on Meta::CPAN

    lock($TEST);
    my $id = $TEST++;

    my ($ok, $g_err, $e_err) = _compare($got, $expected, {});

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print("#      got: $g_err\n");
        print("# expected: $e_err\n");
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

    return ($ok);
}

sub _compare
{