use Cwd qw(getcwd); $CWD = getcwd;
}
+
###
# Notice All test are to be run from the project directory.
# Not in the test directory.
sub new {
my ($class, $test_file, $self) = @_;
$test_file = $0 if not $test_file;
- $self = bless {test_file=> $CWD.'/'.$test_file,test_cnt=>1,sub_cnt=>0,sub_err=>0}, $class;
+ $self = bless {test_file=> $CWD.'/'.$test_file,test_cnt=>1,sub_cnt=>0,sub_err=>0,suited=>1}, $class;
print BLUE."Running -> ".WHITE."$test_file\n".RESET;
$self->{open}=0;
if($test_file =~ m/^$CWD/){
$current_test_file = $test_file;
}else{
$current_test_file = "$CWD/$test_file"
- }
+ }
return $self;
}
+###
+# Makes this test unsuited to be skipped as part of an all test suit run.
+# Usually called on a new test file that needs further work or tests to be done to.
+# Also some experimental test files might be only in direct run be only suitable.
+# By default all tests are suited.
+###
+sub unsuited{my $self = shift; $self->{suited} = 0; return $self}
+
sub failed {
my ($self, $err) = @_;
$err="" if !$err;
}
sub case {
- my ($self, $out, $ref) =@_;
- my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
+ my ($self, $out, $ref) = @_;
+ my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
+ exit 8 if not $self -> {suited} and $ENV{'RUNNING_IN_SUIT'};
die "Case REF not in ordinal string format!\n For -> $CWD/$filename:$line\n" if $ref && $ref !~ m/\d*/g;
$stab="";
nextCase($self) if $self->{open};
$self->{open}=0
}
###
-# Optionally measure time a case needed.
+# Optionally measure the time a case needs.
###
sub start {
my $self = shift;
print GREEN."\t$stab YDef ".$self->{test_cnt} .'.'. ++$self->{sub_cnt}.": Passed -> Scalar [$var] is defined.\n"
}else{
++$self->{sub_err};
- print BLINK. BRIGHT_RED."\t$stab YDef ".$self->{test_cnt} .'.'. ++$self->{sub_cnt}. ": Failed!"." ($self->{sub_err}) ".RESET. RED."Scalar [$var] is not defined!\n";
+ print BLINK. BRIGHT_RED."\t$stab YDef ".$self->{test_cnt} .'.'. $self->{sub_cnt}. ": Failed!"." ($self->{sub_err}) ".RESET. RED."Scalar [$var] is not defined!\n";
return 0;
}
return 1;
my ($failed, $comment, $past, $message, $ErrAt, $cterminated) = @_;
my ($file,$lnErr, $trace);
my $refT = ref($comment);
+ exit 8 if $? == 8;
if($refT eq 'Specio::Exception'){
my $trace = "";
my $i = 3;
###
# To debug in vscode you need the extension LanguageServer and Debugger by Gerald Richter
-# the optional Perl Navigator uses also the LanguagerServer but isn't one.
+# the optional Perl Navigator uses also the LanguageServer but isn't one.
# To debug in vs code the local use lib ... have to be commented out.
-# Do not forget to uncoment them when commiting or using outside of vscode.
+# Do not forget to uncomment them when committing or using outside of vscode.
# Setup settings.json now too.
#
# Here is LanguageServer settings example for settings.json
-# requires full paths for Gerald's extension because it is dumb to reslove this.
+# requires full paths for Gerald's extension because it is dumb to resolve this.
#
# "perl.perlInc": [
# "tests",
use lib "./tests";
try{
- require TestManager;
+ require TestManager;
+ $ENV{'RUNNING_IN_SUIT'} = 1;
}catch{
print RED "Failed to require -> ".WHITE."TestManager.pm".RED.
"\nPlease run tests from the project directory.\n";
my @failed;
my $DISPLAY_ISSUES = 0;
my $RUN_IN_TAINT_MODE = 0;
+my $DISPLAY_TESTS_OUTPUT = 1;
+my $DISPLAY_ERRORS_OUTPUT = 1;
+
my $time_start = strftime "%Y-%m-%d %H:%M:%S", localtime;
foreach my $arg(@ARGV){
print "[$arg]\n";
- $DISPLAY_ISSUES = 1 if $arg =~ /--display[_-]issues/;
- $RUN_IN_TAINT_MODE = 1 if $arg =~ /--run[_-]in[_-]taint[_-]mode/;
+ $DISPLAY_ISSUES = 1 if $arg =~ /--display[_-]issues/i;
+ $RUN_IN_TAINT_MODE = 1 if $arg =~ /--run[_-]in[_-]taint[_-]mode/i;
+ $DISPLAY_TESTS_OUTPUT = 0 if $arg =~ /--display[_-]no[_-]tests[_-]output/i;
+ $DISPLAY_ERRORS_OUTPUT = 0 if $arg =~ /--display[_-]no[_-]errors[_-]output/i;
}
###
# Notice - All test are to be run from the project directory.
###
print '-'x100, "\n";
my $manager = TestManager->new("Test Suit [ $0 ] (".(scalar localtime).")");
-print qq/With options -> --display_issues = $DISPLAY_ISSUES, --run_in_taint_mode = $RUN_IN_TAINT_MODE, CWD = $CWD\n/;
+print qq/With options -> --display_issues = $DISPLAY_ISSUES,
+ --run_in_taint_mode = $RUN_IN_TAINT_MODE,
+ --display_tests_output = $DISPLAY_TESTS_OUTPUT,
+ --display_errors_output = $DISPLAY_ERRORS_OUTPUT,
+ CWD = $CWD\n/;
print '-'x100, "\n";
try{
opendir my($dh), $TEST_LOCAL_DIR or die WHITE."Couldn't open dir '$TEST_LOCAL_DIR':".RED." $!";
my @files = grep { !/^\./ && /^test.*?\.pl$/ && $0 !~ m/$_$/ && -f "./tests/$_" } readdir($dh);
closedir $dh;
- my ($test_pass, $test_fail, $test_cases, @OUT, @ERR, %WARN)=(0,0,0,(),(),());
+ my ($test_pass, $test_fail, $test_cases, $tests_unsuited,@OUT, @ERR, %WARN)=(0,0,0,0,(),(),());
foreach my $file(sort @files) {
push @perl, $file;
print "Running->$file\n";
###
- run (\@perl, \$in, \$output, '2>>', \$warnings);
- ###
+ run \@perl, \$in, \$output, '2>>', \$warnings, timeout(10); #give 10 sec per test file.
+ ###
+ if($? == 2048){
+ $tests_unsuited++; print BOLD. YELLOW."Skipping is unsuited ->$file\n",RESET; next;
+ }
my @test_ret = $output=~m/(\d*)\|(\w*)\|($CWD\/$file)$/g;
$output=~s/\d*\|\w*\|($CWD\/$file)\s$//g;
push @ERR, $output;
}else{
$warnings =~
- s/Can\'t\slocate\sTestManager.pm\sin\s\@INC\s\(you\smay\sneed\sto\sinstall\sthe\sTestManager\smodule\)/Please Uncoment use lib "tests"/;
+ s/Can\'t\slocate\sTestManager.pm\sin\s\@INC\s\(you\smay\sneed\sto\sinstall\sthe\sTestManager\smodule\)/Please Uncomment use lib "tests"/;
push @ERR, "\n $failed -> Pre test cases compiler error: ".RED.$warnings.RESET;
}
}
}
- foreach (@OUT){
+ foreach ($DISPLAY_TESTS_OUTPUT && @OUT){
print $_
- }
- foreach (@ERR){
+ }
+ foreach ($DISPLAY_ERRORS_OUTPUT && @ERR){
print $_
}
print "\n",'-'x100, "\n";
if($test_fail){
print BOLD BRIGHT_RED, "HALT! Not all test have passed!\n",BLUE,
- "\tNumber of test cases run: $test_cases\n",
+ "\tNumber of test cases run: ",BOLD, WHITE,$test_cases,"\n",BLUE,
+ "\tNumber of unsuited tests encountered: ",BOLD, YELLOW,$tests_unsuited,"\n", BLUE,
"\tPassed test count: ", BRIGHT_GREEN, "$test_pass\n", BLUE
"\tFailed test file count: ", BOLD RED,"$test_fail\n",BLUE,
join "",@failed,
lifelog.hopto.org / PerlCNF.git / commitdiff