Assert-Refute

 view release on metacpan or  search on metacpan

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

This is basically what one expects from a module in C<Assert::*> namespace.

=head2 refute_these

B<[DEPRECATED]> Same as above.

It will stay available (with a warning) until as least 0.15.

=cut

sub try_refute(&;@) { ## no critic # need prototype
    my ( $block, @arg ) = @_;

    # Should a missing config even happen? Ok, play defensively...
    my $conf = $CALLER_CONF{+caller};
    if( !$conf ) {
        carp "try_refute(): Usage without explicit configure() is DEPRECATED, assuming { on_fail => 'carp' }";
        $conf = __PACKAGE__->configure( { on_fail => 'carp' }, scalar caller );
    };
    return $conf->{skip_all} if exists $conf->{skip_all};

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

B<[EXPERIMENTAL]>.
Like above, but plan is assumed to be zero and a reason for that is specified.

Note that the contract block is not interrupted,
it's up to the user to call return.
This MAY change in the future.

=cut

sub plan(@) { ## no critic
    current_contract->plan( @_ );
};

=head2 refute( $reason, $message )

Verify (or, rather, try hard to disprove)
an assertion in scope of the current contract.

The test passes if the C<$reason> is I<false>, i.e. an empty string, C<0>,
or C<undef>.

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

        foreach (@$ref) {
            subcontract "Element check", $is_foo, $_;
        };
    };

    $array_of_foo->apply( $valid_user, \@user_list );

=cut

sub subcontract($$@) { ## no critic
    current_contract()->subcontract( @_ );
};

=head2 contract_is

    contract_is $report, $signature, "Message";

Assert that a contract is fulfilled exactly to the specified extent.
See L<Assert::Refute::Report/get_sign> for signature format.

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

=cut

my %Backend;
my %Carp_not;
my $trash_can = __PACKAGE__."::generated::For::Cover::To::See";
my %known;
$known{$_}++ for qw(args list block no_proto manual
    export export_ok no_create);

sub build_refute(@) { ## no critic # Moose-like DSL for the win!
    my ($name, $cond, %opt) = @_;

    my $class = "Assert::Refute::Report";

    if ($name =~ /^(get_|set_|do_)/) {
        croak "build_refute(): fucntion name shall not start with get_, set_, or do_";
    };
    if (my $backend = ( $class->can($name) && ($Backend{$name} || $class )) ) {
        croak "build_refute(): '$name' already registered by $backend";
    };

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

    return 1;
};

=head2 current_contract

Returns a L<Assert::Refute::Report> object.
Dies if no contract is being executed at the time.

=cut

sub current_contract() { ## nocritic
    return $Assert::Refute::DRIVER if $Assert::Refute::DRIVER;

    # Would love to just die, but...
    if ($MORE_DETECTED) {
        require Assert::Refute::Driver::More;
        return $Assert::Refute::DRIVER = Assert::Refute::Driver::More->new;
    };

    croak "Not currently testing anything";
};