Merge branch 'topic/machu/generic-package-instantiation' into 'master'

TGen: Top level generic package test generation

Closes #203

See merge request eng/ide/libadalang-tools!255

src/test-common.adb

@@ -534,6 +534,11 @@ package body Test.Common is
    begin
       L1 := Nesting_1'First;
       L2 := Nesting_2'First;
+
+      if Nesting_1 (L1) /= Nesting_2 (L2) then
+         return "";
+      end if;
+
       loop
 
          if Nesting_1 (L1) = Nesting_2 (L2) then
@@ -560,6 +565,22 @@ package body Test.Common is
 
    end Nesting_Common_Prefix;
 
+   function Skip_Prefix (Identifier : String; Prefix : String)
+      return String is
+      L1 : Integer := Identifier'First;
+      L2 : Integer := Prefix'First;
+   begin
+      while L1 <= Identifier'Last
+         and then L2 <= Prefix'Last
+         and then Identifier (L1) = Prefix (L2)
+      loop
+         L1 := @ + 1;
+         L2 := @ + 1;
+      end loop;
+
+      return Identifier (L1 .. Identifier'Last);
+   end Skip_Prefix;
+
    ------------------------
    -- Nesting_Difference --
    ------------------------
@@ -1355,5 +1376,4 @@ package body Test.Common is
                  => Name.P_Is_Ghost_Code);
       end if;
    end Is_Ghost_Code;
-
 end Test.Common;

src/test-common.ads

@@ -96,6 +96,9 @@ package Test.Common is
      (Nesting_1, Nesting_2 : String) return String;
    --  Returns the common prefix of two nestings
 
+   function Skip_Prefix (Identifier : String; Prefix : String)
+      return String with Pre => Identifier'Last >= Prefix'Last;
+
    function Nesting_Difference
      (Nesting_1, Nesting_2 : String) return String;
    --  Returns difference in ending of two nestings without the first dot

src/test-generation.adb

@@ -104,6 +104,31 @@ package body Test.Generation is
             return Over;
          end if;
 
+         for Inst of Node.As_Basic_Decl.P_Generic_Instantiations loop
+            --  If it is top level generic package instantiation, we call
+            --  `Include_Subp` but with the associated switch set.
+            if Inst.Unit.Root.As_Compilation_Unit.F_Body.Kind
+               = Libadalang.Common.Ada_Library_Item
+              and then Inst
+               .Unit
+               .Root
+               .As_Compilation_Unit
+               .F_Body
+               .As_Library_Item
+               .F_Item = Inst.As_Basic_Decl
+            then
+               if not Include_Subp
+                 (Test.Common.TGen_Libgen_Ctx, Node.As_Basic_Decl, Diags,
+                  Is_Top_Level_Generic_Instantiation => True)
+               then
+                  Report_Err
+                    ("Error while processing " & Node.Image & ":" & ASCII.LF
+                     & Join (Diags) & ASCII.LF);
+               end if;
+               return Over;
+            end if;
+         end loop;
+
          if not Include_Subp
            (Test.Common.TGen_Libgen_Ctx, Node.As_Basic_Decl, Diags)
          then
@@ -116,7 +141,6 @@ package body Test.Generation is
       end if;
 
       --  Traverse subprogram declarations in generic package instantiations
-
       if Node.Kind in Ada_Generic_Package_Instantiation then
          Node.As_Generic_Package_Instantiation.P_Designated_Generic_Decl
          .As_Generic_Package_Decl.F_Package_Decl

src/test-harness.adb

@@ -370,6 +370,27 @@ package body Test.Harness is
 
       Filter_Package_Name : constant String :=
         Common_Package_Name & ".Mapping";
+
+      function Calculate_Tested_Subp_Count return Natural;
+      --  Computes the total number of tested subprograms taking into account
+      --  different instantiations of the same generic packages using gathered
+      --  test cases list.
+
+      function Calculate_Tested_Subp_Count return Natural is
+         Result : Natural := 0;
+      begin
+         for M of Test.Mapping.Mapping loop
+            Result := @ + Natural (M.Test_Info.Length);
+         end loop;
+
+         return Result;
+      end Calculate_Tested_Subp_Count;
+
+      Subp_Count : constant Natural := Calculate_Tested_Subp_Count;
+      Total_Subp_Count : constant Natural :=
+         (if Subp_UT_Counter > Subp_Count
+          then Subp_UT_Counter
+          else Subp_Count);
    begin
       if not Is_Directory (Common_File_Subdir) then
          Make_Dir (Common_File_Subdir);
@@ -423,8 +444,8 @@ package body Test.Harness is
 
       S_Put
         (3,
-         "Test_Routines_Total : constant Positive :="
-         & Natural'Image (Subp_UT_Counter) & ";");
+         "Test_Routines_Total : constant Positive := "
+         & Total_Subp_Count'Image & ";");
       Put_New_Line;
       Put_New_Line;
 
@@ -4643,6 +4664,9 @@ package body Test.Harness is
       Unit := Bod.F_Item.As_Ada_Node;
 
       case Unit.Kind is
+         when Ada_Generic_Package_Instantiation =>
+            Data.Generic_Kind := True;
+            Data.Top_Level_Generic_Instantiation := True;
          when Ada_Package_Decl =>
             Data.Generic_Kind := False;
 

src/test-harness.ads

@@ -137,9 +137,17 @@ package Test.Harness is
             --  List of test_case types in current package
 
             --  Flags:
-            Generic_Kind         : Boolean := False;
+            Generic_Kind                    : Boolean := False;
             --  On, when the given package is generic
 
+            Top_Level_Generic_Instantiation : Boolean := False;
+            --  Whether this declaration concern a top level generic
+            --  instantation.
+            --  Example (bar.ads):
+            --  package Bar is new Foo (Integer);
+            --
+            --  where `Foo` is a generic package
+
             Good_For_Suite       : Boolean := False;
             --  The suite should be generated