]> lifelog.hopto.org Git - PerlCNF.git/commitdiff
Added option for tainted testing and other.
authorWill Budic <redacted>
Fri, 5 Jul 2024 23:38:13 +0000 (09:38 +1000)
committerWill Budic <redacted>
Fri, 5 Jul 2024 23:38:13 +0000 (09:38 +1000)
tests/TestManager.pm
tests/testAll.pl

index c1b4641c513af0333ce029a4d9d3af594ab6959d..6ded117065cc8b5ecb48d632d399300499f794a6 100644 (file)
@@ -37,7 +37,7 @@ sub failed {
     ++$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, qq(\n\t$stab\t at -> $CWD/$filename line on $line.\n), RESET;
+                         BLUE, "\n\t$stab\t at -> ",RESET,"$CWD/$filename line $line.\n", RESET;
     return $self
 }
 
@@ -47,7 +47,7 @@ sub passed {
     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, qq( at -> $CWD/$filename line on $line.\n), RESET;
+                  BLUE, "at -> ",RESET,"$CWD/$filename line $line.\n";
     return $self
 }
 
@@ -57,7 +57,7 @@ sub case {
     $stab="";
     nextCase($self) if $self->{open};
     print BRIGHT_CYAN,"\tCase ".$self->{test_cnt}.": $out",
-          BLUE, qq(\n\t\t at -> $CWD/$filename line on $line.\n), RESET;
+          BLUE, "\t\tat -> ",RESET,"$CWD/$filename line $line.\n", RESET;
     $self->{open}=1;
     return $self
 }
index 07fa95496374c29be74d2581dd4ce54d2aba814b..1f672d38cde9315e81799beb3cb17b62f4515451 100644 (file)
@@ -5,6 +5,7 @@
 ##
 use v5.30;
 #use warnings; use strict;
+use POSIX;
 use Syntax::Keyword::Try;
 use Date::Manip;
 use Term::ANSIColor qw(:constants);
@@ -25,8 +26,14 @@ try{
 
 my $TEST_LOCAL_DIR = './tests';
 my @failed;
-my $SUPRESS_ISSUES = ($ARGV[-1] eq "--display_issues")?0:1;
-
+my $DISPLAY_ISSUES = 0;
+my $RUN_IN_TAINT_MODE = 0;
+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/;
+}
 ###
 #  Notice - All test are to be run from the project directory.
 #  Not in the test directory of this file.
@@ -36,6 +43,7 @@ my $SUPRESS_ISSUES = ($ARGV[-1] eq "--display_issues")?0:1;
 ###
 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 '-'x100, "\n";
 try{
     opendir my($dh), $TEST_LOCAL_DIR or die WHITE."Couldn't open dir '$TEST_LOCAL_DIR':".RED." $!";
@@ -49,7 +57,9 @@ try{
 
         $file = "tests/$file";
         my ($in,$output, $warnings);
-        my @perl = ('/usr/bin/env','perl',$file);
+        my @perl = ('/usr/bin/env','perl');
+        push @perl, '-T' if $RUN_IN_TAINT_MODE;
+        push @perl, $file;
         print "Running->$file\n";
         ###
         run  (\@perl, \$in, \$output, '2>>', \$warnings);
@@ -73,7 +83,13 @@ try{
             print $failed;
             print RED, "\t", $warnings, RESET if $warnings;
             $failed[@failed] = $failed;
-            push @ERR, $output;
+            if($output){
+                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"/;
+                push @ERR, "\n $failed -> Pre test cases compiler error: ".RED.$warnings.RESET;
+            }
         }
 
     }
@@ -84,7 +100,7 @@ try{
         print $_
     }
 
-    print '-'x100, "\n";
+    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",
@@ -105,8 +121,7 @@ try{
     }else{
         print BOLD BRIGHT_RED, "No tests have been run or found!", RESET WHITE, " $0\n", RESET;
     }
-
-    if(not $SUPRESS_ISSUES && %WARN){
+    if($DISPLAY_ISSUES && %WARN){
         print BOLD YELLOW, "Buddy, sorry to tell you. But you got the following Perl Issues:\n",BLUE;
         foreach(keys %WARN){
             my $w = $WARN{$_};
@@ -118,7 +133,9 @@ try{
     }else{
         print "To display all encountered issues or warnings, on next run try:\n\tperl tests/testAll.pl --display_issues\n"
     }
-    print '-'x100, "\n";
+    my $time_stop = strftime "%Y-%m-%d %H:%M:%S", localtime;
+    print qq/Tests ended $time_stop at $CWD. Start time was: $time_start/;
+    print "\n",'-'x100, "\n";
 }
 catch{
    $manager -> dumpTermination($@)