-- -- Copyright (C) 2019-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-Exception -- with Ada.Iterator_Interfaces; with GPR2.Environment; with GPR2.Containers; with GPR2.Context; with GPR2.File_Readers; with GPR2.KB; with GPR2.Log; with GPR2.Message; with GPR2.Path_Name; with GPR2.Project.Configuration; pragma Elaborate (GPR2.Project.Configuration); -- Elaborate to avoid a circular dependency due to default Elaborate_Body with GPR2.Build.Tree_Db; with GPR2.Build.View_Db; with GPR2.Path_Name.Set; with GPR2.Project.Registry.Attribute; limited with GPR2.Project.Tree; with GPR2.Project.View.Set; with GPR2.Project.View.Vector; with GPR2.View_Ids; with GPR2.View_Ids.DAGs; with GPR2.View_Internal; private with Ada.Containers.Indefinite_Ordered_Maps; private with Ada.Containers.Indefinite_Hashed_Maps; private package GPR2.Tree_Internal is use GPR2.Context; use GPR2.Project; use type Ada.Containers.Count_Type; use type GPR2.Project.View.Object; type Object is tagged limited private with Constant_Indexing => Constant_Reference, Default_Iterator => Iterate, Iterator_Element => View.Object; type Object_Access is access all Object; type Project_Descriptor_Kind is (Project_Path, Project_Definition); type Project_Descriptor (Kind : Project_Descriptor_Kind) is record case Kind is when Project_Path => Path : GPR2.Path_Name.Object; when Project_Definition => Data : GPR2.View_Internal.Data; end case; end record; Undefined : constant Object; -- This constant is equal to any object declared without an explicit -- initializer. Get : access function (Tree : GPR2.Project.Tree.Object) return Object_Access; Set : access function (Tree : Object_Access) return GPR2.Project.Tree.Object; function Is_Defined (Self : Object) return Boolean; -- Returns true if Self is defined function Is_Windows_Target (Tree : Object) return Boolean with Pre => Tree.Is_Defined; -- Returns true if tree's target is window function "=" (Left, Right : Object) return Boolean; -- Returns True if Left and Right are the same tree procedure Load (Self : in out Object; Root_Project : Project_Descriptor; Context : GPR2.Context.Object; With_Runtime : Boolean := False; Config : Configuration.Object := Configuration.Undefined; Build_Path : Path_Name.Object := Path_Name.Undefined; Root_Path : Path_Name.Object := Path_Name.Undefined; Subdirs : Optional_Name_Type := No_Name; Src_Subdirs : Optional_Name_Type := No_Name; Check_Shared_Lib : Boolean := True; Absent_Dir_Error : Error_Level := Warning; Implicit_With : GPR2.Path_Name.Set.Object := GPR2.Path_Name.Set.Empty_Set; Resolve_Links : Boolean := False; Pre_Conf_Mode : Boolean := False; File_Reader : GPR2.File_Readers.File_Reader_Reference := GPR2.File_Readers.No_File_Reader_Reference; Environment : GPR2.Environment.Object := GPR2.Environment.Process_Environment); -- Loads a root project -- Filename: if Filename is a file path, then Load_Autoconf will use it as -- root project. If Filename is a directory path, then implicit projects -- are searched there. If not such implicit project is found, then the -- tree is loaded with an empty project. -- Context: list of values to use to fill externals. -- With_Runtime: whether runtime sources are considered. -- Config: the configuration to use to load the tree. -- Build_Path: if defined, indicate the directory to use to build the -- project tree (out of tree build). -- Subdirs: if specified, this value is used as subdirectory for -- lib/obj/exec directories -- Src_Subdirs: if specified, prepend obj/_ or -- obj/ to the list of source directories, if they exist. -- Check_Shared_Lib: checks for shared library compatibilities -- Absent_Dir_Error: whether a missing directory should be treated as an -- error or a warning.( -- Implicit_With: a list of implicitly withed projects. -- Pre_Conf_Mode: set in autoconf mode to disable most errors when trying -- to load a tree without configuration. -- File_Reader: if set, then it is used when parsing Ada sources or -- GPR projects. Else default file reader is used. procedure Load_Configuration (Self : in out Object; Filename : Path_Name.Object) with Pre => Filename.Is_Defined; -- Loads a configuration project for this tree procedure Restrict_Autoconf_To_Languages (Self : in out Object; Langs : Containers.Language_Set); -- Sets a list of languages that auto-configuration will be reduced to -- from the actual set of languages used in project tree. Empty set of -- languages means regular auto-configuration with no reductions. procedure Load_Autoconf (Self : in out Object; Root_Project : Project_Descriptor; Context : GPR2.Context.Object; With_Runtime : Boolean := False; Build_Path : Path_Name.Object := Path_Name.Undefined; Root_Path : Path_Name.Object := Path_Name.Undefined; Subdirs : Optional_Name_Type := No_Name; Src_Subdirs : Optional_Name_Type := No_Name; Check_Shared_Lib : Boolean := True; Absent_Dir_Error : Error_Level := Warning; Implicit_With : GPR2.Path_Name.Set.Object := GPR2.Path_Name.Set.Empty_Set; Resolve_Links : Boolean := False; Target : Optional_Name_Type := No_Name; Language_Runtimes : Containers.Lang_Value_Map := Containers.Lang_Value_Maps.Empty_Map; Base : GPR2.KB.Object := GPR2.KB.Undefined; Config_Project : GPR2.Path_Name.Object := GPR2.Path_Name.Undefined; File_Reader : GPR2.File_Readers.File_Reader_Reference := GPR2.File_Readers.No_File_Reader_Reference; Environment : GPR2.Environment.Object := GPR2.Environment.Process_Environment); -- Loads a tree in autoconf mode. -- If Filename is a file path, then Load_Autoconf will use it as -- root project. If Filename is a directory path, then implicit projects -- are searched there. If not such implicit project is found, then the -- tree is loaded with an empty project. -- If Target is specified, then we use it directly instead of fetching -- the root project attribute. -- Same with the Language_Runtime map: for each language Lang in the -- project tree, if the map has an association (Lang,RTS) then we use it -- instead of any attribute Runtime (Lang) declared in the root project. -- Typically this is useful to enforce precedence of the command-line -- options --target and --RTS[:lang]. -- If Project_Dir is defined, the main project file being parsed is deemed -- to be in this directory, even if it is not the case. Project_Dir is -- defined when a gpr tool is invoked without a project file and is using -- an implicit project file that is virtually in the Project_Dir, but is -- physically in another directory. -- Base is the knowledge base object used to configure the toolchain for -- the project. -- If File_Reader is set, then it is used when parsing Ada sources or -- GPR projects. Else default file reader is used. procedure Unload (Self : in out Object; Full : Boolean := True); -- Unloads the tree and free all associated objects (projects, sources, -- etc...). -- If Full is set, then the cached parsed projects objects will also be -- unloaded. function Root_Project (Self : Object) return View.Object; -- Returns the root project for the given tree function Namespace_Root_Projects (Self : Object) return View.Set.Object; -- Returns the list of namespace root projects: either the root project -- for regular trees, or the root of the subtrees for an aggregate project. function Has_Configuration (Self : Object) return Boolean; -- Returns True if a configuration project is loaded on this tree function Configuration (Self : Object) return Configuration.Object; -- Returns the configuration project for the given tree function Has_Runtime_Project (Self : Object) return Boolean; -- Returns True if a runtime project is loaded on this tree function Runtime_Project (Self : Object) return View.Object; -- Returns the runtime project for the given tree function Target (Self : Object; Canonical : Boolean := False) return Name_Type; -- Returns the target for the project tree function Runtime (Self : Object; Language : Language_Id) return Optional_Name_Type; -- Returns the runtime selected for the given language or the empty string -- if no specific runtime has been configured for this project tree. function With_Runtime (Self : Object) return Boolean; -- Whether creation of the runtime project was requested when loading the -- tree. function Artifacts_Dir (Self : Object) return Path_Name.Object; -- Tries to return a directory that can be used to store artifacts that -- are global to the tree. -- This returns the object directory of the root view if available, else -- it returns the root view's project directory. -- **Important note** project directories may not be writable, as only -- object dirs are required to have read/write access. So this function -- needs to be used with care. function Ordered_Views (Self : Object) return View.Vector.Object; function Log_Messages (Self : Object) return not null access Log.Object; -- Returns the Logs, this contains information, warning and error messages -- found while handling the project. procedure Append_Message (Self : in out Object; Message : GPR2.Message.Object); -- Adds new message into the Log of Self, does nothing if message already -- present. -- Context -- Note that the context of the project tree corresponds to the context of -- the root project view. function Has_Context (Self : Object) return Boolean; -- Returns True if the project tree has some context. If any of the project -- in the tree has some external variables then a context is present. A -- project without context is fully static has it does not reference any -- external (and so modifiable) variables. function Context (Self : Object) return Context.Object; -- Returns the Context for the given project tree type Two_Contexts is array (Context_Kind) of GPR2.Context.Object; -- Root and Aggregate contexts function Contexts (Self : Object) return Two_Contexts; procedure Set_Context (Self : in out Object; Context : GPR2.Context.Object; Changed : access procedure (Project : View.Object) := null); -- Sets the context for the project tree. The callback Changed is called -- for any project view which is impacted by this change of context, i.e. -- if the project view references directly or indirectly an external -- variable. -- Iterator type Cursor is private; No_Element : constant Cursor; function Element (Position : Cursor) return View.Object; function Has_Element (Position : Cursor) return Boolean; package Project_Iterator is new Ada.Iterator_Interfaces (Cursor, Has_Element); type Iterator is new Project_Iterator.Forward_Iterator with private; overriding function First (Iter : Iterator) return Cursor; overriding function Next (Iter : Iterator; Position : Cursor) return Cursor; function Is_Root (Position : Cursor) return Boolean; -- Returns True if the cursor is pointing to the root project function Constant_Reference (Self : aliased Object; Position : Cursor) return View.Object; function Iterate (Self : Object; Kind : Project.Iterator_Control := Project.Default_Iterator; Filter : Project.Filter_Control := Project.Default_Filter; Status : Project.Status_Control := Project.Default_Status) return Project_Iterator.Forward_Iterator'Class; -- Iterates over all project views in the tree given the iterator kind -- (only the project with or without imports) and the filter which can be -- used to iterate over only some specific projects (only the library -- projects for example). -- Views -- Artifacts database Init_Tree_Database : access procedure (Self : in out Build.Tree_Db.Object; Tree : Object); -- Private view of Tree_Db's initialization procedure function Artifacts_Database (Self : Object) return Build.Tree_Db.Object_Access; function Has_Artifacts_Database (Self : Object) return Boolean; function Artifacts_Database (Self : Object; View : GPR2.Project.View.Object) return Build.View_Db.Object with Inline; function Artifacts_Database (Self : Object; View : GPR2.View_Ids.View_Id) return Build.View_Db.Object with Inline; function Source_Option (Self : Object) return Optional_Source_Info_Option; -- Retrieve the level of source information currently requested for -- the tree database. procedure Clear_Sources (Self : Object; View : Project.View.Object := Project.View.Undefined); -- Invalidates the sources for all views in the tree if View is undefined -- or the source in the given view otherwise. This is needed when some -- sources are added or removed from the view. It is not required to call -- Update_Sources below, when the routine Sources on one of the views of -- the tree will be called, the set of sources will be recomputed. procedure Update_Sources (Self : Object; Option : Source_Info_Option := Sources_Units; Messages : out GPR2.Log.Object); -- Ensures that all views' sources are up-to-date. -- Option selects the information that will be gathered on the sources. The -- more information is requested, the slower is the update operation. -- Messages is used to report errors or info about the update. procedure Register_Project_Search_Path (Self : in out Object; Dir : Path_Name.Object); -- Adds a project search path for this tree function Project_Search_Paths (Self : Object) return Path_Name.Set.Object; -- Returns the Tree project search paths function Archive_Suffix (Self : Object) return Filename_Type; -- Returns archive suffix for the project tree function Object_Suffix (Self : Object; Language : Language_Id := Ada_Language) return Filename_Type; -- Returns object suffix for language in project tree function Dependency_Suffix (Self : Object; Language : Language_Id := Ada_Language) return Filename_Type; -- Returns dependency suffix for language in project tree function Subdirs (Self : Object) return Filename_Optional; -- Returns the subdirs parameter of the project tree such that, for -- each project, the actual {executable,object,library} directories are -- {,,}/. function Has_Src_Subdirs (Self : Object) return Boolean; -- Returns True if the Src_Subdirs has been defined function Src_Subdirs (Self : Object) return Filename_Optional; -- Returns the src_subdirs parameter of the project tree such that, -- for each project, the actual source directories list will be prepended -- with {object_dir}/. function Build_Path (Self : Object) return Path_Name.Object; -- Path to build tree function Root_Path (Self : Object) return Path_Name.Object; -- Path to root to consider for the build tree function Reference (Self : Object) return access Object; -- Returns access to itself function Find_Project (Self : Object; Base_Name : Simple_Name) return Path_Name.Object; -- Search for the project file named "Base_Name" through the tree's -- hierarchy or the project paths. If not found, Path_Name.Undefined is -- returned Target_Name : constant Name_Type; -- Native host target ------------------------ -- Internal functions -- ------------------------ function Instance_Of (Self : Object; Instance_Id : GPR2.View_Ids.View_Id) return View.Object with Pre => Self.Is_Defined and then GPR2.View_Ids.Is_Defined (Instance_Id); -- Given a view id return the effective view that should be used. The -- function is mainly used to get the effective view in case a project has -- been extended using extends all. function Target_From_Command_Line (Self : Object; Normalized : Boolean := False) return Name_Type; -- Returns the target specified via --target. If not specified, then -- return "all"; function Runtime_From_Command_Line (Self : Object; Language : Language_Id) return Optional_Name_Type; -- Returns the runtime selected for the given language by the command -- line via --RTS:lang. Returns No_Name if not specified. function Get_KB (Self : Object) return GPR2.KB.Object; function File_Reader (Self : Object) return GPR2.File_Readers.File_Reader_Reference; function Environment (Self : Object) return GPR2.Environment.Object; -- Returns used environment. function Get_View (Self : Object; Id : View_Ids.View_Id) return Project.View.Object; -- Given a View_Id Id returns the associated view if it exists. Returns -- Project.View.Undefined otherwise. function Resolve_Links (Self : Object) return Boolean; -- Returns whether the project should be resolving links private procedure Set_Environment (Self : in out Object; Environment : GPR2.Environment.Object); package PC renames Project.Configuration; package PRA renames GPR2.Project.Registry.Attribute; package Name_View is new Ada.Containers.Indefinite_Ordered_Maps (Name_Type, View.Object); -- Map to find in which view a unit/source is defined package Filename_View is new Ada.Containers.Indefinite_Ordered_Maps (Filename_Type, View.Object); -- Map to find in which view a unit/source is defined package Id_Maps is new Ada.Containers.Indefinite_Hashed_Maps (GPR2.View_Ids.View_Id, View.Object, Hash => GPR2.View_Ids.Hash, Equivalent_Keys => GPR2.View_Ids."="); -- Maps View_Ids to View objects type All_Search_Paths is record Default : Path_Name.Set.Object := Default_Search_Paths (True, GPR2.Environment.Process_Environment); Registered : Path_Name.Set.Object; Appended : Path_Name.Set.Object; All_Paths : Path_Name.Set.Object := Default_Search_Paths (True, GPR2.Environment.Process_Environment); end record; type Object is tagged limited record Self : access Object := null; Root : View.Object; Conf : Project.Configuration.Object; Base : GPR2.KB.Object; Tree_Db : Build.Tree_Db.Object; Runtime : View.Object; With_Runtime : Boolean := False; Messages : aliased Log.Object; Search_Paths : All_Search_Paths; Implicit_With : Path_Name.Set.Object; Resolve_Links : Boolean := False; Build_Path : Path_Name.Object; Root_Path : Path_Name.Object; Subdirs : Unbounded_String; Src_Subdirs : Unbounded_String; Check_Shared_Lib : Boolean := True; Absent_Dir_Error : Error_Level := Warning; Pre_Conf_Mode : Boolean := True; Views_Set : View.Set.Object; -- All projects in registration order Context : Two_Contexts; -- Root and aggregate contexts View_Ids : aliased Id_Maps.Map; View_DAG : GPR2.View_Ids.DAGs.DAG; -- Configuration items from command line Explicit_Target : Unbounded_String; Explicit_Runtimes : Containers.Lang_Value_Map; Langs_Of_Interest : Containers.Language_Set; -- Languages that auto-configuration should be reduced to File_Reader_Ref : GPR2.File_Readers.File_Reader_Reference; Environment : GPR2.Environment.Object := GPR2.Environment.Process_Environment; end record; function "=" (Left, Right : Object) return Boolean is (Left.Self = Right.Self); package Project_View_Store renames GPR2.Project.View.Vector.Vector; type Cursor is record Current : Project_View_Store.Cursor; Tree : access Object := null; end record; type Iterator is new Project_Iterator.Forward_Iterator with record Views : Project_View_Store.Vector; Tree : access Object; end record; No_Element : constant Cursor := (Current => Project_View_Store.No_Element, Tree => null); type Constant_Reference_Type (View : not null access constant Project.View.Object) is record -- We need to keep the underlying reference so that it is not cleared -- upon return of the getter, and so that the container has the proper -- busy state Ref : Project.View.Set.Set.Constant_Reference_Type (View); end record; Undefined : constant Object := (others => <>); Target_Name : constant Name_Type := KB.Default_Target; function Is_Defined (Self : Object) return Boolean is (Self /= Undefined); function Is_Windows_Target (Tree : Object) return Boolean is (Tree.Has_Configuration and then Tree.Configuration.Corresponding_View.Has_Attribute (PRA.Shared_Library_Suffix) and then Tree.Configuration.Corresponding_View.Attribute (PRA.Shared_Library_Suffix).Value_Equal (".dll")); -- ??? We may also check that the Tree target name contains mingw or -- windows. function Contexts (Self : Object) return Two_Contexts is (Self.Context); function Archive_Suffix (Self : Object) return Filename_Type is (if Self.Has_Configuration then Self.Configuration.Archive_Suffix else ".a"); function Object_Suffix (Self : Object; Language : Language_Id := Ada_Language) return Filename_Type is (if Self.Has_Configuration then Self.Configuration.Object_File_Suffix (Language) else ".o"); function Dependency_Suffix (Self : Object; Language : Language_Id := Ada_Language) return Filename_Type is (if Self.Has_Configuration then Self.Configuration.Dependency_File_Suffix (Language) elsif Language = Ada_Language then ".ali" else ".d"); function Reference (Self : Object) return access Object is (Self'Unrestricted_Access); function Subdirs (Self : Object) return Filename_Optional is (Filename_Optional (To_String (Self.Subdirs))); function Src_Subdirs (Self : Object) return Filename_Optional is (Filename_Optional (To_String (Self.Src_Subdirs))); function Build_Path (Self : Object) return Path_Name.Object is (Self.Build_Path); function Root_Path (Self : Object) return Path_Name.Object is (Self.Root_Path); function Runtime_From_Command_Line (Self : Object; Language : Language_Id) return Optional_Name_Type is (if Self.Explicit_Runtimes.Contains (Language) then Optional_Name_Type (Self.Explicit_Runtimes.Element (Language)) else No_Name); function With_Runtime (Self : Object) return Boolean is (Self.With_Runtime); function Has_Artifacts_Database (Self : Object) return Boolean is (Self.Tree_Db.Is_Defined); function Artifacts_Database (Self : Object; View : GPR2.Project.View.Object) return Build.View_Db.Object is (Self.Tree_Db.View_Database (View.Id)); function Artifacts_Database (Self : Object; View : GPR2.View_Ids.View_Id) return Build.View_Db.Object is (Self.Tree_Db.View_Database (View)); function Get_KB (Self : Object) return GPR2.KB.Object is (Self.Base); function File_Reader (Self : Object) return GPR2.File_Readers.File_Reader_Reference is (Self.File_Reader_Ref); function Environment (Self : Object) return GPR2.Environment.Object is (Self.Environment); function Source_Option (Self : Object) return Optional_Source_Info_Option is (Self.Tree_Db.Source_Option); function Resolve_Links (Self : Object) return Boolean is (Self.Resolve_Links); end GPR2.Tree_Internal;