Merge branch 'mr/pmderodat/prep' into 'master'

Preprocessing: fix import of compiler switches for specific sources See merge request eng/libadalang/libadalang!1511
AdaCore · Jan 24, 2024 · 4ee757c · 4ee757c
2 parents 686c63e + 9aaa17f
commit 4ee757c
Show file tree

Hide file tree

Showing 4 changed files with 34 additions and 9 deletions.
diff --git a/extensions/src/libadalang-gpr_utils.adb b/extensions/src/libadalang-gpr_utils.adb
@@ -389,15 +389,38 @@ package body Libadalang.GPR_Utils is
          declare
             use type GPR1.Project_Type;
 
-            Path  : constant GNATCOLL.VFS.Virtual_File := Create (+Filename);
-            Infos : constant GPR1.File_Info_Set :=
-              Tree.GPR1_Value.Info_Set (Path);
+            --  The Info_Set function expects an absolute path: the only way
+            --  GNATCOLL.Projects gives us to find the absolute path for a
+            --  source file given its basename and the project that owns it is
+            --  to manually go through that project's source directories.
+
+            Dirs  : constant GNATCOLL.VFS.File_Array :=
+              View.GPR1_Value.Source_Dirs;
+            Found : Boolean := False;
+            Info  : GPR1.File_Info;
          begin
+            Dir_Lookup : for D of Dirs loop
+               declare
+                  Full_Filename : constant GNATCOLL.VFS.Virtual_File :=
+                    D.Create_From_Dir (+Filename);
+                  Infos         : constant GPR1.File_Info_Set :=
+                    Tree.GPR1_Value.Info_Set (Full_Filename);
+               begin
+                  for Info_Entry of Infos loop
+                     if GPR1.File_Info (Info_Entry).Project /= GPR1.No_Project
+                     then
+                        Found := True;
+                        Info := GPR1.File_Info (Info_Entry);
+                        exit Dir_Lookup;
+                     end if;
+                  end loop;
+               end;
+            end loop Dir_Lookup;
+
             return
-              (for some Info of Infos =>
-               GPR1.File_Info (Info).Project (Root_If_Not_Found => False)
-                 = View.GPR1_Value
-               and then To_Lower (GPR1.File_Info (Info).Language) = "ada");
+              Found
+              and then Info.Project = View.GPR1_Value
+              and then To_Lower (Info.Language) = "ada";
          end;
 
       when GPR2_Kind =>

diff --git a/extensions/src/libadalang-gpr_utils.ads b/extensions/src/libadalang-gpr_utils.ads
@@ -114,8 +114,8 @@ private package Libadalang.GPR_Utils is
 
    function Is_Ada_Source
      (Tree : Any_Tree; View : Any_View; Filename : String) return Boolean;
-   --  Return whether ``Filename`` is an Ada source file that belongs to the
-   --  ``View`` project.
+   --  Return whether ``Filename`` (a base name) is an Ada source file that
+   --  belongs to the ``View`` project.
 
    type Any_Unit_Part is (Unit_Spec, Unit_Body);
 

diff --git a/testsuite/tests/prep/projects/main.adb b/testsuite/tests/prep/projects/main.adb
@@ -51,6 +51,7 @@ procedure Main is
                        (GPR2.Filename_Type (Filename),
                         GPR2.Path_Name.No_Resolution),
          Context  => GPR2.Context.Empty);
+      GPR2_Tree.Update_Sources (With_Runtime => True);
 
       --  Run the extraction on all the requested subprojects
 

diff --git a/testsuite/tests/prep/projects/test.out b/testsuite/tests/prep/projects/test.out
@@ -2,6 +2,7 @@
 
 # default
   -b
+  bar -> Symbol(1)
   foo -> Symbol(1)
   foobar -> Symbol(2)