File Coverage

blib/lib/Test/RandomCheck.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Test::RandomCheck;
use strict;
use warnings;
use Data::Dumper;
use Exporter qw(import);
use Test::RandomCheck::Generator;
use Test::RandomCheck::PRNG;
use Test::More ();
use 5.008_005;
use constant DEBUG => $ENV{RANDOMCHECK_DEBUG};
our $VERSION = '0.02';

our @EXPORT = qw(random_ok);

sub _dump_args ($) {
    my $args = shift;
    my $str = Data::Dumper->new([$args])->Indent(0)->Terse(1)->Dump;

    # Use the list style instead of the array-ref style
    $str =~ s/^\[/(/;
    $str =~ s/\]$/)/;

    "\@_ = $str";
}

sub random_ok (&$;@) {
    my $code = shift;
    my $type = shift;

    my @types;
    push @types, shift
                 while eval { $_[0]->isa("Test::RandomCheck::Types") };
    $type = concat ($type, @types) if @types;

    my %params = @_;
    my $shots = delete $params{shots} // 202;

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $generator = $type->arbitrary->map(sub { scalar $code->(@_), [@_] });
    my $rand = Test::RandomCheck::PRNG->new;
    for (1 .. $shots) {
        my $size = ($_ - 1) % 101;
        my ($is_success, $args) = $generator->pick($rand, $size);
        unless ($is_success) {
            Test::More::diag("Faild by following args: " . _dump_args($args));
            Test::More::diag(
                sprintf "Generated by size=%d", $size
            ) if DEBUG;
            return Test::More::ok 0 ;
        }
    }
    Test::More::ok 1;
}

1;
__END__