my $stab = "";
my $current_test_file;
-use Cwd qw(getcwd);
-my $CWD = getcwd;
+our $CWD;
+
+BEGIN{
+use Cwd qw(getcwd); $CWD = getcwd;
+}
###
# Notice All test are to be run from the project directory.
$self = bless {test_file=> $CWD.'/'.$test_file,test_cnt=>1,sub_cnt=>0,sub_err=>0}, $class;
print BLUE."Running -> ".WHITE."$test_file\n".RESET;
$self->{open}=0;
- $current_test_file = $test_file;
+ if($test_file =~ m/^$CWD/){
+ $current_test_file = $test_file;
+ }else{
+ $current_test_file = "$CWD/$test_file"
+ }
return $self;
}
++$self->{sub_err};
my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
print BLINK. BRIGHT_RED. "\t$stab Fail ".$self->{test_cnt}.".".$sub_cnt.": $err",
- BLUE, "\n\t$stab\t at -> ",RESET,"$CWD/$filename line $line.\n", RESET;
+ BLUE, "\n\t$stab\t at -> ",RESET,"$CWD/$filename:$line\n", RESET;
return $self
}
my $sub_cnt = ++$self->{sub_cnt};
my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
print BRIGHT_GREEN, "\t$stab Pass ".$self->{test_cnt}.".".$sub_cnt.": $msg",
- BLUE, "at -> ",RESET,"$CWD/$filename line $line.\n";
+ BLUE, "at -> ",RESET,"$CWD/$filename:$line\n";
return $self
}
my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
$stab="";
nextCase($self) if $self->{open};
- print BRIGHT_CYAN,"\tCase ".$self->{test_cnt}.": $out",
- BLUE, "\t\tat -> ",RESET,"$CWD/$filename line $line.\n", RESET;
+ print BRIGHT_CYAN,"\tCase ".$self->{test_cnt}.": $out", BLUE, "\n\tat -> ",
+ "$CWD/$filename:$line\n", RESET;
$self->{open}=1;
return $self
}
}
###
-# Following routine is custom made by Will Budic.
+# Following routine is custom made by Will Budić.
# The pattern it seeks is like this comment in source file.
-# To display code where error occured.
+# To display code where error occurred.
###
sub dumpTermination {
my ($failed, $comment, $past, $message, $ErrAt, $cterminated) = @_;
}
}
$comment = $message = $comment->{'message'}.$trace;
- $comment =~ s/eval \{.+\} at/cought at/gs;
- #Old die methods could be present, caught by an Exception, manually having Error@{lno.} set.
+ $comment =~ s/eval \{.+\} at/caught at/gs;
+ # Old die methods could be present, caught by an Exception, manually having Error@{lno.} set.
if($message =~ /^Error\@(\d+)/){
$ErrAt = "\\\@$1";
}
}
}
$comment = $message = $comment->{'message'}.$trace;
- $comment =~ s/eval \{.+\} at/cought at/gs;
+ $comment =~ s/eval \{.+\} at/caught at/gs;
#Old die methods could be present, caught by an Exception, manually having Error@{lno.} set.
if($message =~ /^Error\@(\d+)/){
$ErrAt = "\\\@$1";
}else{
my $error;
($error,$file,$lnErr) = ($message =~ m/(.*)\sat\s*(.*)\sline\s(\d*)\./)
- }
+ }
}else{
($trace,$file,$lnErr) = ($comment =~ m/(.*)\sat\s*(.*)\sline\s(\d*)\.$/);
}
+ $comment =~ s/(\s+line\s)(\d+)\.*\s+/:$2\n/gm;
print BOLD BRIGHT_RED "Test file failed -> $comment";
if($file){
open (my $flh, '<:perlio', $file) or die("Error $! opening file: '$file'\n$comment");
local $. = $i + 1;
my $line = $slurp[$i];
if($. >= $lnErr+1){
- print $comment, RESET.frmln($.).$line; $message =~ m/\s*(.*)\n/ if $message; my $cap = $1?$1:"";
- print "[".$file."] Case $failed->{test_cnt}\n\t$cap\n\t".BRIGHT_RED."Failed\@Line".WHITE." $i -> ", $slurp[$i-1].RESET."\nFailed test file: $current_test_file";
+ print $comment, RESET.frmln($.).$line;
+ $file = "$CWD/$file" if $file !~ m/^$CWD/;
+ print "[".$file.":$i] Case $failed->{test_cnt}\n\t".BRIGHT_RED."Failed\@Line".WHITE." $i -> ",
+ $slurp[$i-1].RESET."Failed test file: $current_test_file";
last
}elsif($line=~m/^\s*(\#.*)/){
if( $1 eq '#'){
1;
=begin copyright
-Programed by : Will Budic
-EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md)
-Source : https://github.com/wbudic/PerlCNF.git
+Programed by : Will Budić
+EContactHash : 990MWWLWM8C2MI8K (https://github.com/wBudić/EContactHash.md)
+Source : https://github.com/wBudić/PerlCNF.git
Documentation : Specifications_For_CNF_ReadMe.md
This source file is copied and usually placed in a local directory, outside of its repository project.
- So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project.
+ So it could not be the actual or current version, can vary or has been modified for what ever purpose in another project.
Please leave source of origin in this file for future references.
-Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md
+Open Source Code License -> https://github.com/wBudić/PerlCNF/blob/master/ISC_License.md
=cut copyright
###