Merge branch 'mr/pmderodat/gpr2-next' into 'master'

Transition to the GPR2-next branch

See merge request eng/libadalang/libadalang!1642

extensions/analysis/bodies

@@ -83,6 +83,8 @@ is
    --  This creates a ref-counted object: we must decrease its ref-count
    --  whether we return normally or through an exception.
 begin
+   Libadalang.Project_Provider.Check_Source_Info (Tree);
+
    begin
       GPR_Impl.Initialize_Context_From_Project
         (Result, Tree, Project, EH_Int, With_Trivia, Tab_Stop);

extensions/src/libadalang-config_pragmas.adb

@@ -251,7 +251,7 @@ package body Libadalang.Config_Pragmas is
    begin
       return Import_From_Project
         (Context,
-         (Kind => GPR2_Kind, GPR2_Value => Tree.Reference),
+         (Kind => GPR2_Kind, GPR2_Value => Tree),
          (Kind => GPR2_Kind, GPR2_Value => View));
    end Import_From_Project;
 

extensions/src/libadalang-data_decomposition.adb

@@ -14,14 +14,18 @@ with GNATCOLL.Mmap;
 with GNATCOLL.OS.FS;
 with GNATCOLL.OS.Process;
 with GNATCOLL.VFS;
+pragma Warnings (Off, "not referenced");
+with GPR2.Build.Source.Sets;
+pragma Warnings (On, "not referenced");
 with GPR2.Containers;
 with GPR2.Context;
 with GPR2.Path_Name;
 with GPR2.Path_Name.Set;
 
-with Libadalang.Auto_Provider; use Libadalang.Auto_Provider;
-with Libadalang.Common;        use Libadalang.Common;
-with Libadalang.GPR_Utils;     use Libadalang.GPR_Utils;
+with Libadalang.Auto_Provider;    use Libadalang.Auto_Provider;
+with Libadalang.Common;           use Libadalang.Common;
+with Libadalang.GPR_Utils;        use Libadalang.GPR_Utils;
+with Libadalang.Project_Provider; use Libadalang.Project_Provider;
 
 package body Libadalang.Data_Decomposition is
 
@@ -2682,6 +2686,8 @@ package body Libadalang.Data_Decomposition is
 
       Args : Argument_List;
    begin
+      Check_Source_Info (Tree);
+
       Args.Append ("gprbuild");
       Args.Append ("-c");
       Args.Append ("-P" & String (Tree.Root_Project.Path_Name.Value));
@@ -2785,6 +2791,8 @@ package body Libadalang.Data_Decomposition is
       --  Look for JSON files for all Ada sources
 
       declare
+         use type GPR2.Language_Id;
+
          Actual_View   : constant GPR2.Project.View.Object :=
            (if View.Is_Defined then View else Tree.Root_Project);
          Loaded_Subdir : constant GPR2.Filename_Optional := Tree.Subdirs;
@@ -2800,7 +2808,8 @@ package body Libadalang.Data_Decomposition is
 
             Obj_Dir := V.Object_Directory;
             if Loaded_Subdir'Length > 0 then
-               pragma Assert (Obj_Dir.Simple_Name = Loaded_Subdir);
+               pragma Assert
+                 (V.Is_Runtime or else Obj_Dir.Simple_Name = Loaded_Subdir);
                Obj_Dir := Obj_Dir.Containing_Directory;
             end if;
             if Subdirs'Length > 0 then
@@ -2810,7 +2819,7 @@ package body Libadalang.Data_Decomposition is
             Trace.Trace ("Object directory: " & String (Obj_Dir.Value));
 
             for S of V.Sources loop
-               if S.Is_Ada then
+               if S.Language = GPR2.Ada_Language then
                   Trace.Trace
                     ("Processing Ada source: " & String (S.Path_Name.Value));
                   Repinfo_File :=

extensions/src/libadalang-gpr_utils.adb

@@ -9,14 +9,17 @@ with GNAT.Strings; use GNAT.Strings;
 
 with GNATCOLL.Utils;
 with GNATCOLL.VFS;        use GNATCOLL.VFS;
+with GPR2.Build.Source;
+pragma Warnings (Off, "not referenced");
+with GPR2.Build.Source.Sets;
+pragma Warnings (On, "not referenced");
+with GPR2.Build.Unit_Info;
 with GPR2.Containers;
 with GPR2.Path_Name;
 with GPR2.Project.Attribute;
 with GPR2.Project.Attribute.Set;
 with GPR2.Project.Attribute_Index;
-with GPR2.Project.Source;
 with GPR2.Project.View.Set;
-with GPR2.Unit;
 
 package body Libadalang.GPR_Utils is
 
@@ -425,13 +428,12 @@ package body Libadalang.GPR_Utils is
 
       when GPR2_Kind =>
          declare
-            Path : constant GPR2.Path_Name.Object :=
-              GPR2.Path_Name.Create_File
-                (GPR2.Filename_Type (Filename), GPR2.Path_Name.No_Resolution);
-            File : constant GPR2.Project.Source.Object :=
-              View.GPR2_Value.Source (Path);
+            use type GPR2.Language_Id;
+
+            File : constant GPR2.Build.Source.Object :=
+              View.GPR2_Value.Source (GPR2.Simple_Name (Filename));
          begin
-            return File.Is_Defined and then File.Is_Ada;
+            return File.Is_Defined and then File.Language = GPR2.Ada_Language;
          end;
       end case;
    end Is_Ada_Source;
@@ -511,32 +513,53 @@ package body Libadalang.GPR_Utils is
          --  instead of using this internal API.
 
          declare
-            procedure Process_Wrapper (Source : GPR2.Project.Source.Object);
+            procedure Process_Wrapper (Source : GPR2.Build.Source.Object);
             --  Call ``Process`` on all units in ``Source``
 
+            function Unit_Name (U : GPR2.Build.Unit_Info.Object) return String
+            is (String (U.Name)
+                & (if U.Kind in GPR2.S_Separate
+                   then "." & String (U.Separate_Name)
+                   else ""));
+
             ---------------------
             -- Process_Wrapper --
             ---------------------
 
-            procedure Process_Wrapper (Source : GPR2.Project.Source.Object) is
+            procedure Process_Wrapper (Source : GPR2.Build.Source.Object) is
                Filename : constant String := String (Source.Path_Name.Value);
             begin
+               if not Source.Has_Units then
+                  return;
+               end if;
+
                for U of Source.Units loop
-                  Process.all
-                    (Unit_Name => String (U.Name),
-                     Unit_Part => (if U.Kind in GPR2.Unit.Spec_Kind
-                                   then Unit_Spec
-                                   else Unit_Body),
-                     Filename  => Filename);
+
+                  --  TODO (eng/gpr/gpr-issues#227) GPR2 cannot find the name
+                  --  of some units. Discard them since we cannot do anything
+                  --  useful with them, and they may cause trouble later on
+                  --  (conflicting sources for the same empty unit name).
+
+                  declare
+                     N : constant String := Unit_Name (U);
+                  begin
+                     if N /= "" then
+                        Process.all
+                          (Unit_Name => N,
+                           Unit_Part => (if U.Kind in GPR2.S_Spec
+                                         then Unit_Spec
+                                         else Unit_Body),
+                           Filename  => Filename);
+                     end if;
+                  end;
                end loop;
             end Process_Wrapper;
          begin
             if Recursive then
-               Tree.GPR2_Value.For_Each_Source
-                 (View             => View.GPR2_Value,
-                  Action           => Process_Wrapper'Access,
-                  Language         => GPR2.Ada_Language,
-                  Externally_Built => True);
+               for V of View.GPR2_Value.Closure (Include_Self => True) loop
+                  Iterate_Ada_Units
+                    (Tree, (GPR2_Kind, V), Process, Recursive => False);
+               end loop;
             else
                for S of View.GPR2_Value.Sources loop
                   Process_Wrapper (S);
@@ -590,15 +613,19 @@ package body Libadalang.GPR_Utils is
 
          --  Also process compiler switches for all Ada sources
 
-         for Source of Indexes (Self, Switches) loop
-            declare
-               Filename : constant String := Source.To_String;
-            begin
-               if Is_Ada_Source (Tree, Self, Filename) then
-                  Process_Switches (Self, Switches, Filename);
-               end if;
-            end;
-         end loop;
+         declare
+            Index_List : constant XString_Array := Indexes (Self, Switches);
+         begin
+            for Source of Index_List loop
+               declare
+                  Filename : constant String := Source.To_String;
+               begin
+                  if Is_Ada_Source (Tree, Self, Filename) then
+                     Process_Switches (Self, Switches, Filename);
+                  end if;
+               end;
+            end loop;
+         end;
       end Process_View;
 
       ----------------------

extensions/src/libadalang-gpr_utils.ads

@@ -29,8 +29,7 @@ private package Libadalang.GPR_Utils is
    type Any_Tree (Kind : Project_Kind := Project_Kind'First) is record
       case Kind is
          when GPR1_Kind => GPR1_Value : GPR1.Project_Tree_Access;
-         when GPR2_Kind =>
-           GPR2_Value : access constant GPR2.Project.Tree.Object;
+         when GPR2_Kind => GPR2_Value : GPR2.Project.Tree.Object;
       end case;
    end record;
 

extensions/src/libadalang-helpers.adb

@@ -19,10 +19,7 @@ with GNAT.Traceback.Symbolic;
 with GNATCOLL.File_Paths;
 with GNATCOLL.Strings; use GNATCOLL.Strings;
 with GNATCOLL.VFS;     use GNATCOLL.VFS;
-with GPR2.Containers;
-with GPR2.Context;
-with GPR2.Path_Name;
-with GPR2.Project.Configuration;
+with GPR2.Options;
 with GPR2.Project.View;
 with GPR2.Project.View.Set;
 
@@ -510,8 +507,7 @@ package body Libadalang.Helpers is
 
                if Use_GPR2 then
                   App_Ctx.Provider :=
-                    (Kind         => GPR2_Project_File,
-                     GPR2_Project => GPR2_Project.Reference);
+                    (Kind => GPR2_Project_File, GPR2_Project => GPR2_Project);
                else
                   App_Ctx.Provider :=
                     (Kind => Project_File, Project => Project);
@@ -823,8 +819,8 @@ package body Libadalang.Helpers is
       Target, RTS, Config_File : String := "";
       Project                  : in out GPR2.Project.Tree.Object)
    is
-      Ctx   : GPR2.Context.Object;
-      Error : Boolean := False;
+      Options : GPR2.Options.Object;
+      Error   : Boolean := False;
 
       procedure Set_Scenario_Var (Name, Value : String);
       --  Set the given scenario variable in ``Ctx``
@@ -835,7 +831,7 @@ package body Libadalang.Helpers is
 
       procedure Set_Scenario_Var (Name, Value : String) is
       begin
-         Ctx.Include (GPR2.Name_Type (Name), Value);
+         Options.Add_Switch (GPR2.Options.X, Name & "=" & Value);
       end Set_Scenario_Var;
 
    begin
@@ -845,57 +841,46 @@ package body Libadalang.Helpers is
       Iterate_Scenario_Vars (Scenario_Vars, Set_Scenario_Var'Access);
 
       --  Load the project tree with either a config file (if given) or the
-      --  requested target/runtime , and beware of loading errors
+      --  requested target/runtime, and beware of loading errors
 
-      declare
-         PF      : constant GPR2.Path_Name.Object :=
-           GPR2.Path_Name.Create_File
-             (GPR2.Filename_Type (Project_File), GPR2.Path_Name.No_Resolution);
-         RTS_Map : GPR2.Containers.Lang_Value_Map;
       begin
-         if Config_File = "" then
-            if RTS /= "" then
-               RTS_Map.Include (GPR2.Ada_Language, RTS);
+         Options.Add_Switch (GPR2.Options.P, Project_File);
+
+         if Config_File /= "" then
+            if Target /= "" or else RTS /= "" then
+               Abort_App
+                 ("--config not allowed if --target or --RTS are passed");
             end if;
-            Project.Load_Autoconf
-              (Filename          => PF,
-               Context           => Ctx,
-               Target            => GPR2.Optional_Name_Type (Target),
-               Language_Runtimes => RTS_Map);
+            Options.Add_Switch (GPR2.Options.Config, Config_File);
+         end if;
 
-         elsif Target /= "" or else RTS /= "" then
-            Abort_App ("--config not allowed if --target or --RTS are passed");
+         if Target /= "" then
+            Options.Add_Switch (GPR2.Options.Target, Target);
+         end if;
 
-         else
-            declare
-               F      : constant GPR2.Path_Name.Object :=
-                 GPR2.Path_Name.Create_File (GPR2.Filename_Type (Config_File));
-               Config : constant GPR2.Project.Configuration.Object :=
-                 GPR2.Project.Configuration.Load (F);
-            begin
-               Project.Load
-                 (Filename => PF,
-                  Context  => Ctx,
-                  Config   => Config);
-            end;
+         if RTS /= "" then
+            Options.Add_Switch (GPR2.Options.RTS, RTS);
          end if;
 
-         Project.Update_Sources (With_Runtime => True);
+         Error := not Project.Load (Options);
       exception
          when Exc : GPR2.Project_Error =>
             Error := True;
             Libadalang.Project_Provider.Trace.Trace
               ("Loading failed: " & Exception_Message (Exc));
       end;
 
+      Error := Error or else not Update_Sources (Project);
+
       --  Whether the project loaded successfully or not, print messages since
       --  they may contain warnings. If there was an error, abort the App.
 
+      Error := Error or else Project.Log_Messages.Has_Error;
       Project.Log_Messages.Output_Messages
         (Information => False,
          Warning     => True,
          Error       => True);
-      if Error or else Project.Log_Messages.Has_Error then
+      if Error then
          Abort_App;
       end if;
 

extensions/src/libadalang-helpers.ads

@@ -89,7 +89,7 @@ package Libadalang.Helpers is
          when Auto_Dir =>
             Dirs, Found_Files : String_Vectors.Vector;
          when GPR2_Project_File =>
-            GPR2_Project : access GPR2.Project.Tree.Object;
+            GPR2_Project : GPR2.Project.Tree.Object;
       end case;
    end record;
 

extensions/src/libadalang-preprocessing.adb

@@ -19,10 +19,11 @@ with GNATCOLL.Strings;  use GNATCOLL.Strings;
 with Langkit_Support.Slocs;  use Langkit_Support.Slocs;
 with Langkit_Support.Text;   use Langkit_Support.Text;
 
-with Libadalang.Common;    use Libadalang.Common;
-with Libadalang.GPR_Utils; use Libadalang.GPR_Utils;
-with Libadalang.PP_Impl;   use Libadalang.PP_Impl;
-with Libadalang.PP_Lexer;  use Libadalang.PP_Lexer;
+with Libadalang.Common;           use Libadalang.Common;
+with Libadalang.GPR_Utils;        use Libadalang.GPR_Utils;
+with Libadalang.PP_Impl;          use Libadalang.PP_Impl;
+with Libadalang.PP_Lexer;         use Libadalang.PP_Lexer;
+with Libadalang.Project_Provider; use Libadalang.Project_Provider;
 
 package body Libadalang.Preprocessing is
 
@@ -730,11 +731,11 @@ package body Libadalang.Preprocessing is
       Default_Config : out File_Config;
       File_Configs   : out File_Config_Maps.Map) is
    begin
+      Check_Source_Info (Tree);
+
       Extract_Preprocessor_Data_From_Project
-        (Tree           => (Kind       => GPR2_Kind,
-                            GPR2_Value => Tree'Unrestricted_Access),
-         View           => (Kind       => GPR2_Kind,
-                            GPR2_Value => Project),
+        (Tree           => (Kind => GPR2_Kind, GPR2_Value => Tree),
+         View           => (Kind => GPR2_Kind, GPR2_Value => Project),
          Default_Config => Default_Config,
          File_Configs   => File_Configs);
    end Extract_Preprocessor_Data_From_Project;