view release on metacpan or  search on metacpan

lib/Test/Simpler.pm  view on Meta::CPAN

package Test::Simpler;

use warnings;
use strict;
use autodie;
use 5.014;

our $VERSION = '0.000007';

use PadWalker  qw< peek_my peek_our >;
use Data::Dump qw< dump >;
use List::Util qw< max >;

use base 'Test::Builder::Module';

# Export the module's interface...
our @EXPORT      = ( 'ok' );
our @EXPORT_OK   = ();
our %EXPORT_TAGS = ();

sub ok($;$) {
    my $outcome = shift;
    my $desc    = @_ ? "@_" : undef;

    # Grab the upscope variables...
    my %value_for = ( %{peek_our(1)}, %{peek_my(1)} );

    # Cache for source code...
    state %source;

    # Where were we called???
    my ($package, $file, $line) = caller;

    # Grab the source...
    if (!exists $source{$file}) {
        open my $fh, '<', $file;
        $source{$file} = do { local $/; readline $fh };
    }
    my $source = $source{$file};
    my $remove_lines = $line - 1;
    $source =~ s{ \A (?: \N*\n ){$remove_lines} }{}xms;

    # Extract code from source...
    use PPI;
    my $doc = PPI::Document->new(\$source);

    # Extract statement from code...
    my @target;
    STATEMENT:
    for my $statement (@{ $doc->find('PPI::Statement') }) {
        my @token = $statement->children;
        next STATEMENT if $token[0]->content ne 'ok';
        @target = @token[1..$#token];  # don't need the 'ok'
        last STATEMENT;
    }

    # Did we find the statement?
    die "Can't understand arguments to ok()" if !@target;

    # Flatten to a list of relevant tokens...
    SKIPPED:
    while (1) {
        # Remove whitespaces...
        if ($target[0]->isa('PPI::Token::Whitespace')) {
            shift @target;
        }
        # Step into lists...
        elsif ($target[0]->isa('PPI::Structure::List')) {
            @target = $target[0]->children;
        }