Initial commit.
This commit is contained in:
parent
492a920207
commit
978931965e
19
Build.PL
Normal file
19
Build.PL
Normal file
@ -0,0 +1,19 @@
|
||||
use Module::Build;
|
||||
|
||||
my $home = $ENV{HOME};
|
||||
|
||||
my $build = Module::Build->new(
|
||||
module_name => 'Owl::TestRunner',
|
||||
license => 'GPLv3',
|
||||
dist_author => 'Sergio Iglesias <contact@owlcode.tech>',
|
||||
dist_abstract => 'A test runner for Perl',
|
||||
requires => {
|
||||
'Path::Tiny' => 0,
|
||||
'Types::Standard' => 0,
|
||||
'Params::ValidationCompiler' => 0,
|
||||
'Getopt::Long::Descriptive' => 0,
|
||||
'Capture::Tiny' => 0,
|
||||
'DB_File' => 0,
|
||||
},
|
||||
);
|
||||
$build->create_build_script;
|
129
lib/Owl/TestRunner.pm
Normal file
129
lib/Owl/TestRunner.pm
Normal file
@ -0,0 +1,129 @@
|
||||
package Owl::TestRunner v0.0.1;
|
||||
|
||||
use v5.30.0;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use DB_File;
|
||||
|
||||
use Params::ValidationCompiler qw/validation_for/;
|
||||
use Types::Standard qw/ArrayRef Str/;
|
||||
|
||||
use Getopt::Long::Descriptive;
|
||||
use Path::Tiny qw/path/;
|
||||
use Capture::Tiny qw/tee_merged/;
|
||||
use Term::ANSIColor qw/color/;
|
||||
|
||||
my $db_file = path($0)->parent->child('test.db');
|
||||
my %test_files_success_status;
|
||||
tie %test_files_success_status, 'DB_File', $db_file;
|
||||
|
||||
my @errors;
|
||||
|
||||
my $ERROR_CODE_SOME_TEST_FAILED = 500;
|
||||
|
||||
{
|
||||
my $validator = validation_for(
|
||||
params => {
|
||||
test_files => {
|
||||
type => ArrayRef [Str],
|
||||
}
|
||||
}
|
||||
);
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = bless {}, $class;
|
||||
|
||||
my %params = $validator->(@_);
|
||||
|
||||
my $test_files = $params{test_files};
|
||||
|
||||
$self->{test_files} = [@$test_files];
|
||||
|
||||
return $self;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub _options {
|
||||
my $self = shift;
|
||||
if ( !defined $self->{options} ) {
|
||||
$self->{options} = {};
|
||||
$self->_getopt;
|
||||
}
|
||||
return $self->{options};
|
||||
}
|
||||
|
||||
sub _getopt {
|
||||
my $self = shift;
|
||||
my ($opt, $usage) = describe_options(
|
||||
'./test_runner.pl %o',
|
||||
[ 'clean|c', "Cleans the previously succeded tests", ],
|
||||
[ 'halt|h', "Halts on error", ],
|
||||
[],
|
||||
[ 'help', "print usage message and exit", { shortcircuit => 1 } ],
|
||||
);
|
||||
|
||||
print($usage->text), die if $opt->help;
|
||||
my $options = $self->_options;
|
||||
$options->{halt} = $opt->halt;
|
||||
$options->{clean} = $opt->clean;
|
||||
}
|
||||
|
||||
sub run {
|
||||
my $self = shift;
|
||||
if ($self->_options->{clean}) {
|
||||
%test_files_success_status = ();
|
||||
}
|
||||
for my $test_file (@{$self->{test_files}}) {
|
||||
if ($self->_test_already_succeded($test_file)) {
|
||||
say omited() . "$test_file last test was successful.";
|
||||
next;
|
||||
}
|
||||
my $return_code;
|
||||
my ($merged) = tee_merged {
|
||||
$return_code = system $test_file;
|
||||
};
|
||||
$test_files_success_status{$test_file} = !$return_code;
|
||||
if ($return_code) {
|
||||
push @errors, error() . "File $test_file\n" . $merged;
|
||||
if ($self->_options->{halt}) {
|
||||
$self->show_errors;
|
||||
}
|
||||
}
|
||||
}
|
||||
$self->show_errors;
|
||||
}
|
||||
|
||||
sub show_errors {
|
||||
for my $error (@errors) {
|
||||
say $error;
|
||||
}
|
||||
if (@errors) {
|
||||
exit $ERROR_CODE_SOME_TEST_FAILED;
|
||||
}
|
||||
exit 0;
|
||||
}
|
||||
|
||||
sub omited {
|
||||
return color('blue').'[[OMITED]] '.reset_color();
|
||||
}
|
||||
|
||||
sub error {
|
||||
return color('red').'[[ERROR]] '.reset_color();
|
||||
}
|
||||
|
||||
sub reset_color {
|
||||
return color('reset');
|
||||
}
|
||||
|
||||
sub _test_already_succeded {
|
||||
my $self = shift;
|
||||
|
||||
my $test = shift;
|
||||
|
||||
return $test_files_success_status{$test};
|
||||
}
|
||||
1;
|
Loading…
Reference in New Issue
Block a user