Francois Gouget : testbot/TestWTBS: Allow checking which test units were run.

[Alexandre Julliard]

Module: tools
Branch: master
Commit: 7a60a50ad9a7d3a269af90c8a50bf73572735716
URL:    https://source.winehq.org/git/tools.git/?a=commit;h=7a60a50ad9a7d3a269af90c8a50bf73572735716

Author: Francois Gouget <fgouget at codeweavers.com>
Date:   Wed Jan 20 13:57:03 2021 +0100

testbot/TestWTBS: Allow checking which test units were run.

This is useful to verify the TestBot runs extra tests when patching a
resource file or other non-test file.

For instance:
----- TestWTBS -----
p win.TestUnits cabinet:extract cabinet:fdi
----- TestWTBS -----

Signed-off-by: Francois Gouget <fgouget at codeweavers.com>
Signed-off-by: Alexandre Julliard <julliard at winehq.org>

---

 testbot/tests/TestWTBS | 54 +++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 51 insertions(+), 3 deletions(-)

diff --git a/testbot/tests/TestWTBS b/testbot/tests/TestWTBS
index af43060..b4460b8 100755
--- a/testbot/tests/TestWTBS
+++ b/testbot/tests/TestWTBS
@@ -344,6 +344,25 @@ sub LoadTestInfo($)
   return $TestInfo;
 }
 
+sub GetReportTestUnits($)
+{
+  my ($LogPath) = @_;
+
+  my $TestUnits = {};
+  if (open(my $LogFile, "<", $LogPath))
+  {
+    foreach my $Line (<$LogFile>)
+    {
+      if ($Line =~ m%^([_.a-z0-9-]+:[_a-z0-9]*) start (?:-|[/_.a-z0-9-]+) (?:-|[.0-9a-f]+)%)
+      {
+        $TestUnits->{$1} = 1;
+      }
+    }
+    close($LogFile);
+  }
+  return $TestUnits;
+}
+
 
 #
 # Verify the Jobs and Tasks
@@ -469,9 +488,9 @@ By default the TestFailures field is not checked.
 
 =cut
 
-sub CheckTask($$$)
+sub CheckTask($$$$)
 {
-  my ($Task, $TaskType, $TestInfo) = @_;
+  my ($Task, $TaskType, $TestInfo, $TestUnits) = @_;
 
   my $TaskInfo = $TestInfo->{$TaskType};
   if (CheckValue($TaskInfo->{Status}))
@@ -490,6 +509,11 @@ sub CheckTask($$$)
     {
       $ReportCount++;
       $LogType = "report";
+      if ($TaskType eq "wine")
+      {
+        my $ReportTestUnits = GetReportTestUnits($LogPath);
+        map { $TestUnits->{wine}->{$_} = 1 } (keys %$ReportTestUnits);
+      }
     }
     if ($TaskInfo->{"$LogType.errors"})
     {
@@ -561,6 +585,14 @@ lines below to make sure the TestBot did not try to run the tests on Windows.
 p build.HasTask 0
 p win.HasTask 0
 
+=item <tests.TestUnits>
+
+Checks that the TestBot ran at least the test units mentioned in this
+space-separated list on the VMs matching the specified category.
+
+For instance:
+p win.TestUnits cabinet:extract cabinet:fdi
+
 =cut
 
 sub CheckJobTree($)
@@ -569,6 +601,7 @@ sub CheckJobTree($)
   return if (!IsJobInRange($Job));
 
   my ($TestInfo, $HasTask);
+  my $TestUnits = { wine => {} };
 
   my $Steps = $Job->Steps;
   foreach my $Step (sort { $a->No <=> $b->No } @{$Job->Steps->GetItems()})
@@ -589,7 +622,14 @@ sub CheckJobTree($)
     foreach my $Task (sort { $a->No <=> $b->No } @{$Step->Tasks->GetItems()})
     {
       $HasTask->{$TaskType} = 1;
-      CheckTask($Task, $TaskType, $TestInfo);
+      CheckTask($Task, $TaskType, $TestInfo, $TestUnits);
+      if ($TaskType =~ /^win(?:32|64)$/)
+      {
+        my $TestUnit = $Step->FileName;
+        $TestUnit =~ s/_test(?:64)?\.exe$//;
+        $TestUnit .= ":". $Task->CmdLineArg;
+        $TestUnits->{$TaskType}->{$TestUnit} = 1;
+      }
     }
   }
   CheckJob($Job, $TestInfo);
@@ -608,6 +648,14 @@ sub CheckJobTree($)
         $HasTask->{$Type} ||= 0;
         is($HasTask->{$Type}, $TypeInfo->{HasTask}, "Check the presence of $Type tasks for job ". $Job->Id);
       }
+      if (CheckValue($TypeInfo->{TestUnits}))
+      {
+        foreach my $TestUnit (split / +/, $TypeInfo->{TestUnits})
+        {
+          ok($TestUnits->{$Type}->{$TestUnit}, "Check that $TestUnit was tested by $Type VMs for job ". $Job->Id) or
+              or diag("TestUnits=", join(" ", sort keys %{$TestUnits->{$Type}}));
+        }
+      }
     }
   }
 }