File Coverage

blib/lib/Test/Expr.pm

Criterion	Covered	Total	%
statement	52	82	63.4
branch	4	12	33.3
condition	3	8	37.5
subroutine	12	13	92.3
pod			n/a
total	71	115	61.7

package Test::Expr;
our $VERSION = '0.000005';

use 5.012; use warnings;
use Keyword::Declare;
use Data::Dump;
use List::Util 'max';
use Test::More;
use parent 'Exporter';
our @EXPORT = @Test::More::EXPORT;

sub _trim {
    my $str = shift;
    $str =~ s{\A\s*|\s*\Z}{}g;
    return $str;
}

my $PERL_VAR = qr{ ((?&PerlVariable)) $PPR::GRAMMAR }xms;

sub import {
    my ($package) = @_;
    $package->export_to_level(1, @_);

    keyword ok (Expr $test) {{{
        ok do{«$test»}, q{«$test»};
    }}}

    keyword ok (ListElem $test, Comma, ListElem $desc) {
        # Work out what values to report if there's a problem...
        my @vars = grep {defined} $test =~ m{$PERL_VAR}g;
        my $var_len = max map {length} @vars;
        my %seen;
        my @diagnostics
            = map {qq{diag sprintf(q{    %${var_len}s --> }, q{$_}), Data::Dump::dump($_);}}
                  grep { !$seen{$_}++ }
                       @vars;

        unshift @diagnostics, qq{diag q{  because:};}
            if @diagnostics;
        unshift @diagnostics, qq{diag q{}; diag q{  ($test) was false};}
            if (eval($desc)//'') ne qq{$test};

        # Build the test code...
        qq{
            if ($test) {
                Test::More::ok(1, $desc);
            }
            else {
                fail($desc); @diagnostics diag q{};
            }
        };
    }
}

1; # Magic true value required at end of module
__END__