From: Will Budic <redacted>
Date: Thu, 26 Jun 2025 02:26:43 +0000 (+1000)
Subject: Imp. suited and unsited tests functionality.
X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=a7cf6baeb741e203ab1022bfb952181575e16383;p=PerlCNF.git

Imp. suited and unsited tests functionality.
---

diff --git a/tests/TestManager.pm b/tests/TestManager.pm
index 498992d..0943e8f 100644
--- a/tests/TestManager.pm
+++ b/tests/TestManager.pm
@@ -19,6 +19,7 @@ BEGIN{
 use Cwd qw(getcwd); $CWD = getcwd;
 }
 
+
 ###
 #  Notice All test are to be run from the project directory.
 #  Not in the test directory.
@@ -26,17 +27,25 @@ use Cwd qw(getcwd); $CWD = getcwd;
 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;
@@ -59,8 +68,9 @@ sub passed {
 }
 
 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};
@@ -92,7 +102,7 @@ sub nextCase {
     $self->{open}=0
 }
 ###
-# Optionally measure time a case needed.
+# Optionally measure the time a case needs.
 ###
 sub start {
     my $self = shift;
@@ -159,7 +169,7 @@ sub isDefined{
         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;
@@ -225,6 +235,7 @@ sub dumpTermination {
     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;
@@ -333,13 +344,13 @@ sub frmln { my($at)=@_;
 
 ###
 # 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",
diff --git a/tests/testAll.pl b/tests/testAll.pl
index 1f672d3..0c734af 100644
--- a/tests/testAll.pl
+++ b/tests/testAll.pl
@@ -17,7 +17,8 @@ use lib "./local";
 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";
@@ -28,11 +29,16 @@ my $TEST_LOCAL_DIR = './tests';
 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.
@@ -43,7 +49,11 @@ foreach my $arg(@ARGV){
 ###
 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." $!";
@@ -51,7 +61,7 @@ try{
     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) {
 
@@ -62,8 +72,11 @@ try{
         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;
 
@@ -87,23 +100,24 @@ try{
                 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,