Assert-Refute

 view release on metacpan or  search on metacpan

lib/Assert/Refute/Build.pm  view on Meta::CPAN

message. (Think C<ok 1>, C<ok 1 'test passed'>).

=head1 FUNCTIONS

All functions are exportable.

=cut

use Carp;
use Data::Dumper;
use Scalar::Util qw(weaken blessed set_prototype looks_like_number refaddr);
use parent qw(Exporter);
our @EXPORT = qw(build_refute current_contract to_scalar);

# NOTE HACK
# If we're being loaded after Test::More, we're *likely* inside a test script
# This has to be re-done properly
# Cannot instantiate *here* because cyclic dependencies
#    so wait until current_contract() is called
our $MORE_DETECTED = Test::Builder->can("new") ? 1 : 0;

lib/Assert/Refute/T/Basic.pm  view on Meta::CPAN

If L<Test::More> is in action, a unit testing script is assumed.
If neither is true, an exception is thrown.

In addition, a C<Assert::Refute::Report-E<gt>function_name> method with
the same signature is generated for each of them
(see L<Assert::Refute::Build>).

=cut

use Carp;
use Scalar::Util qw(blessed looks_like_number refaddr);
use parent qw(Exporter);

use Assert::Refute::Build;
our @EXPORT = qw( diag note );
our @EXPORT_OK;

=head2 is $got, $expected, "explanation"

Check for equality, C<undef> equals C<undef> and nothing else.

lib/Assert/Refute/T/Basic.pm  view on Meta::CPAN

build_refute cmp_ok => sub {
    my ($x, $op, $y) = @_;

    my $fun = $compare{$op};
    croak "cmp_ok(): Comparison '$op' not implemented"
        unless $fun;

    my @missing;
    if ($numeric{$op}) {
        push @missing, '1 '.to_scalar($x).' is not numeric'
            unless looks_like_number $x or blessed $x;
        push @missing, '2 '.to_scalar($y).' is not numeric'
            unless looks_like_number $y or blessed $y;
    } else {
        push @missing, '1 is undefined' unless defined $x;
        push @missing, '2 is undefined' unless defined $y;
    };

    return "cmp_ok '$op': argument ". join ", ", @missing
        if @missing;

    return '' if $fun->($x, $y);
    return "$x\nis not '$op'\n$y";

lib/Assert/Refute/T/Numeric.pm  view on Meta::CPAN

    };

    my $total = calculate_price();
    try_refute {
        is_between $total, 1, 100, "Price within reasonable limits";
    };

=cut

use Carp;
use Scalar::Util qw(looks_like_number);
use parent qw(Exporter);

use Assert::Refute::Build;

=head2 is_between $x, $lower, $upper, [$message]

Note that $x comes first and I<not> between boundaries.

=cut

build_refute is_between => sub {
    my ($x, $min, $max) = @_;

    croak "Non-numeric boundaries: ".to_scalar($min, 0).",".to_scalar($max, 0)
        unless looks_like_number $min and looks_like_number $max;

    return "Not a number: ".to_scalar($x, 0)
        unless looks_like_number $x;

    return $min <= $x && $x <= $max ? '' : "$x is not in [$min, $max]";
}, args => 3, export => 1;

=head2 within_delta $x, $expected, $delta, [$message]

Test that $x differs from $expected value by no more than $delta.

=cut

build_refute within_delta => sub {
    my ($x, $exp, $delta) = @_;

    croak "Non-numeric boundaries: ".to_scalar($exp, 0)."+-".to_scalar($delta, 0)
        unless looks_like_number $exp and looks_like_number $delta;

    return "Not a number: ".to_scalar($x, 0)
        unless looks_like_number $x;

    return abs($x - $exp) <= $delta ? '' : "$x is not in [$exp +- $delta]";
}, args => 3, export => 1;

=head2 within_relative $x, $expected, $delta, [$message]

Test that $x differs from $expected value by no more than $expected * $delta.

=cut

build_refute within_relative => sub {
    my ($x, $exp, $delta) = @_;

    croak "Non-numeric boundaries: ".to_scalar($exp, 0)."+-".to_scalar($delta, 0)
        unless looks_like_number $exp and looks_like_number $delta;

    return "Not a number: ".to_scalar($x, 0)
        unless looks_like_number $x;

    return abs($x - $exp) <= abs($exp * $delta)
        ? ''
        : "$x differs from $exp by more than ".$exp*$delta;
}, args => 3, export => 1;

=head1 SEE ALSO

L<Test::Number::Delta>.

t/101-Report-refute.t  view on Meta::CPAN

ok $c->refute( 0, "right" ), "refute(false) yelds true";
ok $c->is_passing, "still passing";
ok !$c->refute( "foobared", "wrong" ), "refute(false) yelds true";
ok !$c->is_passing, "not passing now";
is $c->get_count, 2, "2 tests now";
is $c->get_fail_count, 1, "1 of them failed";
is_deeply [$c->get_tests], [1..2], "get_tests works";

like $c->get_tap, qr/^ok 1 - right\nnot ok 2 - wrong\n# .*foobared.*\n$/s,
    "get_tap looks like tap";

$c->done_testing;
like $c->get_tap, qr/\n1..2(\n|$)/, "Plan present";

eval {
    $c->done_testing;
};

like $@, qr/Assert::Refute::Report->done_testing.*done_testing.*no more/
    , "done_testing locks execution log";