Merge branch 'garese/fix-interface' into 'master'

Fix test drivers interfaces for stubbed libraries

Closes #215

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

src/test-harness.adb

@@ -3066,6 +3066,9 @@ package body Test.Harness is
          end loop;
       end Add_Nesting_Hierarchy_Dummies;
 
+      Sources_Names : String_Set.Set := String_Set.Empty_Set;
+      --  Used to store the names of all sources of this project to be able to
+      --  add those needed in the interface if the project is a library.
    begin
       Trace (Me, "Generate_Stub_Test_Driver_Projects");
       Increase_Indent (Me);
@@ -3237,37 +3240,89 @@ package body Test.Harness is
 
          S_Cur := P.Sources_List.First;
          if S_Cur /= List_Of_Strings.No_Element then
-            S_Put (3, "for Source_Files use");
+            S_Put (3, "for Source_Files use (");
             Put_New_Line;
 
             while S_Cur /= List_Of_Strings.No_Element loop
 
-               if S_Cur = P.Sources_List.First then
-                  S_Put
-                    (5,
-                     "("""
-                     & Base_Name (List_Of_Strings.Element (S_Cur))
-                     & """");
-               else
-                  S_Put
-                    (6,
-                     """"
-                     & Base_Name (List_Of_Strings.Element (S_Cur))
-                     & """");
-               end if;
+               declare
+                  Source_Name : constant String :=
+                    Base_Name (List_Of_Strings.Element (S_Cur));
+               begin
+                  S_Put (6, """" & Source_Name & """");
+                  Sources_Names.Include (Source_Name);
+               end;
 
                Next (S_Cur);
 
-               if S_Cur = List_Of_Strings.No_Element then
-                  S_Put (0, ");");
+               S_Put
+                 (0,
+                  (if S_Cur = List_Of_Strings.No_Element then ");" else ","));
+               Put_New_Line;
+            end loop;
+         end if;
+         Put_New_Line;
+         Put_New_Line;
+
+         --  If the project is a library, declare an interface exposing all the
+         --  originally exposed units and all other relevant units.
+
+         if Test.Skeleton.Source_Table.Project_Is_Library
+           (P.Name_Of_Extended.all)
+         then
+            declare
+               Interfaces_Attribute : constant Attribute_Pkg_List :=
+                 Build ("", "interfaces");
+
+               Project : constant Project_Type :=
+                 GNATCOLL.Projects.Project_From_Name
+                   (Source_Project_Tree, P.Name_Of_Extended.all);
+
+               Driver_Sources_Present : constant Boolean :=
+                 P.Sources_List.First = List_Of_Strings.No_Element;
+            begin
+               S_Put (3, "for Interfaces use (");
+
+               --  Go through all units exposed in the interface and add them
+               --  to the driver's interface.
+               declare
+                  Exposed_List : constant String_List :=
+                    Project.Attribute_Value (Interfaces_Attribute).all;
+               begin
+                  for Source of Exposed_List loop
+                     S_Put (0, """" & Source.all & """,");
+                  end loop;
+               end;
+
+               --  If there are source for this test driver, add all of them to
+               --  the interface. If not, only add the relevant unit.
+
+               if Driver_Sources_Present then
+                  S_Put (0, """" & Base_Name (P.UUT_File_Name.all) & """");
                else
-                  S_Put (0, ",");
+                  declare
+                     Cur : String_Set.Cursor := Sources_Names.First;
+                  begin
+                     while Cur /= String_Set.No_Element loop
+                        S_Put (0, """" & String_Set.Element (Cur) & """");
+
+                        Next (Cur);
+
+                        if Cur /= String_Set.No_Element then
+                           S_Put (0, ",");
+                        end if;
+                     end loop;
+                  end;
                end if;
 
-               Put_New_Line;
+               S_Put (0, ");");
 
-            end loop;
+               --  Reset the sources list to be added to the interface
+               Sources_Names := String_Set.Empty_Set;
+            end;
          end if;
+         Put_New_Line;
+         Put_New_Line;
 
          S_Put (3, "package Compiler renames Gnattest_Common.Compiler;");
 

src/test-skeleton-source_table.adb

@@ -1424,6 +1424,10 @@ package body Test.Skeleton.Source_Table is
 
          Resolved_Dep_List : List_Of_Strings.List;
          --  List of relative paths to the stub project dependencies of Proj
+
+         Sources_Names : String_Set.Set := String_Set.Empty_Set;
+      --  Used to store the names of all sources of this project to be able to
+      --  add those needed in the interface if the project is a library.
       begin
          if Processed_Projects.Contains (Proj) then
             return;
@@ -1587,43 +1591,39 @@ package body Test.Skeleton.Source_Table is
                   S_Put (3, "for Source_Files use ();");
                   Put_New_Line;
                end if;
+
                while E_Cur /= String_Set.No_Element loop
-                  if not Excluded_Test_Data_Files.Contains
-                    (Get_Source_Stub_Data_Spec (String_Set.Element (E_Cur)))
-                  then
+                  declare
+                     Source : constant String := String_Set.Element (E_Cur);
+                     Stub_Data_Spec : constant String :=
+                       Get_Source_Stub_Data_Spec (Source);
+                     Stub_Data_Body : constant String :=
+                       Get_Source_Stub_Data_Body (Source);
+                  begin
+                     if not Excluded_Test_Data_Files.Contains (Stub_Data_Spec)
+                     then
+                        S_Put (6, """" & Base_Name (Stub_Data_Spec) & """,");
+                        Sources_Names.Include (Base_Name (Stub_Data_Spec));
+                        Put_New_Line;
+                     end if;
+
+                     if not Excluded_Test_Data_Files.Contains (Stub_Data_Body)
+                     then
+                        S_Put (6, """" & Base_Name (Stub_Data_Body) & """,");
+                        Sources_Names.Include (Base_Name (Stub_Data_Body));
+                        Put_New_Line;
+                     end if;
+
                      S_Put
-                       (6,
-                        """"
-                        & Base_Name
-                            (Get_Source_Stub_Data_Spec
-                               (String_Set.Element (E_Cur)))
-                        & """,");
-                     Put_New_Line;
-                  end if;
-                  if not Excluded_Test_Data_Files.Contains
-                    (Get_Source_Stub_Data_Body (String_Set.Element (E_Cur)))
-                  then
+                       (6, """" & Base_Name (Get_Source_Body (Source)) & """");
+                     Sources_Names.Include (Base_Name (Source));
+                     Next (E_Cur);
+
                      S_Put
-                       (6,
-                        """"
-                        & Base_Name
-                            (Get_Source_Stub_Data_Body
-                               (String_Set.Element (E_Cur)))
-                        & """,");
+                       (0,
+                        (if E_Cur = String_Set.No_Element then ");" else ","));
                      Put_New_Line;
-                  end if;
-                  S_Put
-                    (6,
-                     """"
-                     & Base_Name (Get_Source_Body (String_Set.Element (E_Cur)))
-                     & """");
-                  Next (E_Cur);
-                  if E_Cur = String_Set.No_Element then
-                     S_Put (0, ");");
-                  else
-                     S_Put (0, ",");
-                  end if;
-                  Put_New_Line;
+                  end;
                end loop;
             end if;
 
@@ -1670,6 +1670,47 @@ package body Test.Skeleton.Source_Table is
                     (Stub_Project_Prefix & Current_Infix & Proj)
                   & """;");
                Put_New_Line;
+
+               declare
+                  Interfaces_Attribute : constant Attribute_Pkg_List :=
+                    Build ("", "interfaces");
+
+                  Project : constant Project_Type :=
+                    GNATCOLL.Projects.Project_From_Name
+                      (Source_Project_Tree, Proj);
+               begin
+                  S_Put (3, "for Interfaces use (");
+
+                  --  Go through all units exposed in the interface and
+                  --  add them to the driver's interface.
+                  declare
+                     Exposed_List : constant String_List :=
+                       Project.Attribute_Value
+                         (Interfaces_Attribute).all;
+                  begin
+                     for Source of Exposed_List loop
+                        S_Put (0, """" & Source.all & """,");
+                     end loop;
+                  end;
+
+                  --  Include all sources in the interface
+                  if not Sources_Names.Is_Empty then
+                     declare
+                        Cur : String_Set.Cursor := Sources_Names.First;
+                     begin
+                        while Cur /= String_Set.No_Element loop
+                           S_Put (0, """" & String_Set.Element (Cur) & """");
+
+                           Next (Cur);
+
+                           if Cur /= String_Set.No_Element then
+                              S_Put (0, ",");
+                           end if;
+                        end loop;
+                     end;
+                  end if;
+                  S_Put (3, ");");
+               end;
             end if;
             Put_New_Line;
 

testsuite/tests/test/215-interface/lib1.gpr

@@ -0,0 +1,10 @@
+with "lib2";
+
+library project Lib1 is
+  for Library_Name use "lib1";
+  for Library_Dir use "lib1";
+  for Interfaces use ("a.ads", "b.ads");
+  for Source_Dirs use ("src-lib1");
+  for Object_Dir use "obj";
+  for Languages use ("Ada");
+end Lib1;

testsuite/tests/test/215-interface/lib2.gpr

@@ -0,0 +1,10 @@
+with "lib3";
+
+library project Lib2 is
+  for Library_Name use "lib2";
+  for Library_Dir use "lib2";
+  for Interfaces use ("c.ads", "d.ads");
+  for Source_Dirs use ("src-lib2");
+  for Object_Dir use "obj";
+  for Languages use ("Ada");
+end Lib2;

testsuite/tests/test/215-interface/lib3.gpr

@@ -0,0 +1,8 @@
+library project Lib3 is
+  for Library_Name use "lib3";
+  for Library_Dir use "lib3";
+  for Interfaces use ("e.ads", "f.ads");
+  for Source_Dirs use ("src-lib3");
+  for Object_Dir use "obj";
+  for Languages use ("Ada");
+end Lib3;

testsuite/tests/test/215-interface/src-lib1/a.adb

@@ -0,0 +1,14 @@
+with B.A;
+pragma Unreferenced (B.A);
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body A is
+
+   function Hoho return String is ("Hoho");
+
+   Procedure Hihi is
+   begin
+      Put_Line (Hoho);
+   end Hihi;
+
+end A;

testsuite/tests/test/215-interface/src-lib1/a.ads

@@ -0,0 +1,7 @@
+package A is
+
+   function Hoho return String;
+
+   Procedure Hihi;
+
+end A;

testsuite/tests/test/215-interface/src-lib1/b-a.adb

@@ -0,0 +1,9 @@
+with C;
+pragma Unreferenced (C);
+
+package body B.A is
+   function BA_Func return Boolean is
+   begin
+      return Dummy_BA;
+   end BA_Func;
+end B.A;

testsuite/tests/test/215-interface/src-lib1/b-a.ads

@@ -0,0 +1,5 @@
+package B.A is
+   Dummy_BA : Boolean := True;
+
+   function BA_Func return Boolean;
+end B.A;

testsuite/tests/test/215-interface/src-lib1/b-b.adb

@@ -0,0 +1,6 @@
+package body B.B is
+   function BB_Func return Boolean is
+   begin
+      return Dummy_BB;
+   end BB_Func;
+end B.B;

testsuite/tests/test/215-interface/src-lib1/b-b.ads

@@ -0,0 +1,5 @@
+package B.B is
+   Dummy_BB : Boolean := True;
+
+   function BB_Func return Boolean;
+end B.B;

testsuite/tests/test/215-interface/src-lib1/b.ads

@@ -0,0 +1,5 @@
+package B is
+   Dummy_B : Boolean := True;
+
+   function B_Func return Boolean is (Dummy_B);
+end B;

testsuite/tests/test/215-interface/src-lib2/c.adb

@@ -0,0 +1,14 @@
+with D.A;
+pragma Unreferenced (D.A);
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body C is
+
+   function Hoho return String is ("Hoho");
+
+   Procedure Hihi is
+   begin
+      Put_Line (Hoho);
+   end Hihi;
+
+end C;

testsuite/tests/test/215-interface/src-lib2/c.ads

@@ -0,0 +1,7 @@
+package C is
+
+   function Hoho return String;
+
+   Procedure Hihi;
+
+end C;

testsuite/tests/test/215-interface/src-lib2/d-a.adb

@@ -0,0 +1,9 @@
+with E;
+pragma Unreferenced (E);
+
+package body D.A is
+   function DA_Func return Boolean is
+   begin
+      return Dummy_DA;
+   end DA_Func;
+end D.A;

testsuite/tests/test/215-interface/src-lib2/d-a.ads

@@ -0,0 +1,5 @@
+package D.A is
+   Dummy_DA : Boolean := True;
+
+   function DA_Func return Boolean;
+end D.A;

testsuite/tests/test/215-interface/src-lib2/d-b.adb

@@ -0,0 +1,6 @@
+package body D.B is
+   function DB_Func return Boolean is
+   begin
+      return Dummy_DB;
+   end DB_Func;
+end D.B;

testsuite/tests/test/215-interface/src-lib2/d-b.ads

@@ -0,0 +1,5 @@
+package D.B is
+   Dummy_DB : Boolean := True;
+
+   function DB_Func return Boolean;
+end D.B;

testsuite/tests/test/215-interface/src-lib2/d.ads

@@ -0,0 +1,5 @@
+package D is
+   Dummy_D : Boolean := True;
+
+   function D_Func return Boolean is (Dummy_D);
+end D;