File Coverage

blib/lib/Test/Synopsis/Expectation.pm

Criterion	Covered	Total	%
statement	100	112	89.2
branch	30	36	83.3
condition	6	7	85.7
subroutine	21	23	91.3
pod	4	4	100.0
total	161	182	88.4

package Test::Synopsis::Expectation;
use 5.008005;
use strict;
use warnings;
use parent qw/Test::Builder::Module/;

my @test_more_exports;
BEGIN { @test_more_exports = (qw/done_testing/) }
use PPI::Tokenizer;
use ExtUtils::Manifest qw/maniread/;
use Test::More import => \@test_more_exports;
use Test::Synopsis::Expectation::Pod;

our $VERSION = "0.11";
our @EXPORT  = (@test_more_exports, qw/all_synopsis_ok synopsis_ok/);

my $prepared = '';
my $ignorings = [];

sub prepare {
    $prepared = shift;
}

sub set_ignorings {
    $ignorings = shift;
    $ignorings = [$ignorings] if ref $ignorings ne 'ARRAY';

    return $ignorings;
}

sub all_synopsis_ok {
    my $builder = __PACKAGE__->builder;
    my @files   = _list_up_files_from_manifest($builder);
    for my $file (@files) {
        _synopsis_ok($file);
    }
}

sub synopsis_ok {
    my ($files) = @_;

    $files = [$files] if ref $files ne 'ARRAY';
    for my $file (@$files) {
        _synopsis_ok($file);
    }
}

sub _synopsis_ok {
    my ($file) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $parser = Test::Synopsis::Expectation::Pod->new;
    $parser->parse_file($file);

    my $block_num = 1;
    for my $target_code (@{$parser->{target_codes}}) {
        my ($expectations, $code) = _analyze_target_code($target_code);

        _check_syntax($code, $block_num, $file);
        for my $expectation (@$expectations) {
            _check_with_expectation($expectation, $block_num, $file);
        }

        $block_num++;
    }
}

sub _check_syntax {
    package Test::Synopsis::Expectation::Sandbox;
    eval $_[0]; ## no critic
    if ($@) {
        Test::More::fail("Syntax OK: $_[2] (SYNOPSIS Block: $_[1])");
    }
    else {
        Test::More::pass("Syntax OK: $_[2] (SYNOPSIS Block: $_[1])");
    }
}

sub _check_with_expectation {
    package Test::Synopsis::Expectation::Sandbox;

    # $_[0] is expectation
    my $got       = eval $_[0]->{code};     ## no critic
    my $expected  = eval $_[0]->{expected}; ## no critic
    my $method    = $_[0]->{method};
    my $test_name = "$_[2] (SYNOPSIS Block: $_[1], Line: $_[0]->{line_num})";

    if ($method eq 'is') {
        Test::More::is($got, $expected, $test_name);
    } elsif ($method eq 'isa') {
        Test::More::isa_ok($got, $expected, $test_name);
    } elsif ($method eq 'like') {
        Test::More::like($got, $expected, $test_name);
    } elsif ($method eq 'is_deeply') {
        Test::More::is_deeply($got, $expected, $test_name);
    } elsif ($method eq 'success') {
        Test::More::ok($got, $test_name);
    }
}

sub _analyze_target_code {
    my ($target_code) = @_;

    my $deficient_brace = 0;
    my $code = $prepared || ''; # code for test
    my @expectations; # store expectations for test
    my $line_num = 1;
    for my $line (split /\n\r?/, $target_code) {
        my $tokens = PPI::Tokenizer->new(\$line)->all_tokens;

        if (grep {$_->{content} eq '...' && $_->isa('PPI::Token::Operator')} @$tokens) {
            next;
        }

        for my $ignoring (@$ignorings) {
            $line =~ s/\Q$ignoring\E//g;
        }

        $code .= "$line\n";

        # Count the number of left braces to complete deficient right braces
        $deficient_brace++ if (grep {$_->{content} eq '{' && $_->isa('PPI::Token::Structure')}  @$tokens);
        $deficient_brace-- if (grep {$_->{content} eq '}' && $_->isa('PPI::Token::Structure')}  @$tokens);

        # Extract comment statement
        # Tokens contain one comment token on a line, at the most
        if (my ($comment) = grep {$_->isa('PPI::Token::Comment')} @$tokens) {
            # Accept special comment for this module
            # e.g.
            #     # => is 42
            my ($expectation) = $comment->{content} =~ /#\s*=>\s*(.+)/;
            next unless $expectation;

            # Accept test methods as string
            my $method;
            if ($expectation =~ s/^(?:(is|isa|is_deeply|like)\s|(success))//) {
                $method = $1 || $2;
            }

            push @expectations, +{
                'method'   => $method || 'is',
                'expected' => $expectation,
                'code'     => $code . ('}' x $deficient_brace),
                'line_num' => $line_num,
            };
        }

        $line_num++;
    }

    return (\@expectations, $code);
}

sub _list_up_files_from_manifest {
    my ($builder) = @_;

    my $manifest = $ExtUtils::Manifest::MANIFEST;
    if ( not -f $manifest ) {
        $builder->plan( skip_all => "$manifest doesn't exist" );
    }
    return grep { m!\Alib/.*\.pm\Z! } keys %{ maniread() };
}
1;
__END__