view release on metacpan or  search on metacpan

t/run_tests.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use autodie;
use feature qw(say);

use FindBin;
use File::Spec;
use Test::More;
use Test::Differences;

my $INDENT         = qr/\s+/;
my $SYSCALL_NAME   = qr/[a-zA-Z_:]+/;
my $SYSCALL_ARGS   = qr/\((?<args>.*)\)/;
my $SYSCALL_RESULT = qr/([-]?\d+)|([*])/;
my $LOCATION       = qr/.*/;

sub capture_trace_output {
    my ( @command ) = @_;

    note('running command: ' . join(' ', @command));

    my ( $read, $write );
    pipe $read, $write;

    my $pid = fork();

    if($pid) {
        close $write;

        my @lines = <$read>;
        chomp @lines;
        close $read;
        waitpid $pid, 0;

        return ( $? >> 8, \@lines );
    } else {
        close $read;
        open STDOUT, '>', File::Spec->devnull;
        open STDERR, '>&', $write;

        exec @command;
    }
}

sub parse_args {
    my ( $args ) = @_;

    return [ split /\s*,\s*/, $args ];
}

sub parse_location {
    my ( $location ) = @_;

    if($location eq '(BEGIN)') { # special case for now
        return {
            filename => 'BEGIN',
            line     => 0,
        };
    }

    if($location =~ /^at (?<filename>.*) line (?<line>\d+)[.]?$/) {
        return {
            filename => $+{'filename'},
            line     => $+{'line'},
        };
    } else {
        die "Unable to parse location '$location'";
    }
}