------------------------------------------------------------------------------ -- -- -- GPR PROJECT MANAGER -- -- -- -- Copyright (C) 2006-2021, Free Software Foundation, Inc. -- -- -- -- This library is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 3, or (at your option) any later -- -- version. This library is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- ------------------------------------------------------------------------------ -- This unit is responsible for parsing the gprconfig knowledge base with Ada.Containers.Doubly_Linked_Lists; with Ada.Containers.Indefinite_Doubly_Linked_Lists; with Ada.Containers.Hashed_Maps; with Ada.Containers.Vectors; with Ada.Strings.Unbounded; with GNAT.Regpat; package GPR.Knowledge is use Ada.Strings.Unbounded; package String_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists (String); Generate_Error : exception; -- To be raised when an error occurs during generation of config files -------------------- -- Knowledge base -- -------------------- -- The following types and subprograms manipulate the knowledge base. This -- base is a set of XML files that describe how to find compilers that are -- installed on the system and that match specific criteria. type Knowledge_Base is private; function Default_Knowledge_Base_Directory return String; -- Return the default location of the knowledge database. This is based on -- the installation directory of the executable. procedure Parse_Knowledge_Base (Base : in out Knowledge_Base; Directory : String; Parse_Compiler_Info : Boolean := True; Validate : Boolean := False); -- Parse info from the knowledge base, and store it in memory. -- Only information relevant to the current host is parsed. -- If Parse_Compiler_Info is False, then only the information about -- target sets is parsed. -- This procedure will raise Invalid_Knowledge_Base if the base contains -- incorrect data. -- If Validate is True, the contents of the knowledge base is first -- validated with an XSD schema. procedure Free_Knowledge_Base (Base : in out Knowledge_Base); -- Deallocate all resources occupied by the knowledge base. Invalid_Knowledge_Base : exception; -- To be raised when an error occurred while parsing the knowledge base Knowledge_Base_Validation_Error : exception; -- Some files in the knowledge base are invalid. Pedantic_KB : Boolean := False; -- Expect strict accordance between the expected knowledge base scheme -- and actual files parsed. When parsing an older knowledge base some -- attributes may be missing (i.e. canonical target) and that would lead -- to Invalid_Knowledge_Base raised. ----------------- -- Target sets -- ----------------- -- One of the information pieces contain in the database is a way to -- normalize target names, since various names are used in different -- contexts thus making it harder to write project files depending on the -- target. type Targets_Set_Id is private; -- Identify a target aliases set All_Target_Sets : constant Targets_Set_Id; -- Matches all target sets Unknown_Targets_Set : constant Targets_Set_Id; -- Special target set when a target is not known function Query_Targets_Set (Base : Knowledge_Base; Target : String) return Targets_Set_Id; -- Get the target alias set id for a target, or Unknown_Targets_Set if -- no such target is in the base. procedure Get_Targets_Set (Base : in out Knowledge_Base; Target : String; Id : out Targets_Set_Id); -- Get the target alias set id for a target. If not already in the base, -- add it. function Normalized_Target (Base : Knowledge_Base; Set : Targets_Set_Id) return String; -- Return the normalized name for a target set function Get_Fallback_List (Base : Knowledge_Base; On_Target : Targets_Set_Id) return String_Lists.List; -- Get the list of fallback targets for a given target set. --------------- -- Compilers -- --------------- -- Most of the information in the database relates to compilers. However, -- you do not have direct access to the generic description that explains -- how to find compilers on the PATH and how to compute their attributes -- (version, runtimes,...) Instead, this package gives you access to the -- list of compilers that were found. The package ensures that all -- information is only computed at most once, to save on system calls and -- provide better performance. type Compiler is private; type Compiler_Access is access all Compiler; function Runtime_Dir_Of (Comp : Compiler_Access) return Name_Id; -- Return the name of the runtime directory for the compiler. Returns -- No_Name if Comp is null. package Compiler_Lists is new Ada.Containers.Doubly_Linked_Lists (Compiler_Access); -- A list of compilers function Is_Selected (Comp : Compiler) return Boolean; function Target (Comp : Compiler) return Name_Id; procedure Set_Selection (Compilers : in out Compiler_Lists.List; Cursor : Compiler_Lists.Cursor; Selected : Boolean); procedure Set_Selection (Comp : in out Compiler; Selected : Boolean); -- Toggle the selection status of a compiler in the list. -- This does not check that the selection is consistent though (use -- Is_Supported_Config to do this test) function To_String (Base : Knowledge_Base; Comp : Compiler; As_Config_Arg : Boolean; Show_Target : Boolean := False; Rank_In_List : Integer := -1; Parser_Friendly : Boolean := False) return String; -- Return a string representing the compiler. It is either the --config -- argument (if As_Config_Arg is true) or the string to use in the -- interactive menu otherwise. -- If Rank_In_List is specified, it is written at the beginning of the -- line. -- If Parser_Friendly is set, then the list is displayed in a way that can -- be easily parsed automatically function To_String (Base : Knowledge_Base; Compilers : Compiler_Lists.List; Selected_Only : Boolean; Show_Target : Boolean := False; Parser_Friendly : Boolean := False) return String; -- Return the list of compilers. -- Unselectable compilers are hidden. If Selected_Only is true, then only -- compilers that are currently selected are displayed. -- If Parser_Friendly is set, then the list is displayed in a way that can -- be easily parsed automatically function Display_Before (Comp1, Comp2 : Compiler_Access) return Boolean; -- Whether Comp1 should be displayed before Comp2 when displaying lists of -- compilers. This ensures that similar languages are grouped, among othe -- things. procedure Filter_Compilers_List (Base : Knowledge_Base; Compilers : in out Compiler_Lists.List; For_Target_Set : Targets_Set_Id); -- Based on the currently selected compilers, check which other compilers -- can or cannot be selected by the user. -- This is not the case if the resulting selection in Compilers is not a -- supported config (multiple compilers for the same language, set of -- compilers explicitly marked as unsupported in the knowledge base,...). ------------------ -- Command line -- ------------------ -- This package provides support for manipulating the --config command line -- parameters. The intent is that they have the same form in all the tools -- that support it. The information provides to --config might be partial -- only, and this package provides support for completing it automatically -- based on the knowledge base. procedure Parse_Config_Parameter (Base : Knowledge_Base; Config : String; Compiler : out Compiler_Access; Requires_Compiler : out Boolean); -- Parse the --config parameter, and store the (partial) information -- found in Compiler. -- When a switch matches a language that requires no compiler, -- Requires_Compiler is set to False. -- Raises Invalid_Config if Config is invalid Invalid_Config : exception; -- Raised when the user has specified an invalid --config switch procedure Complete_Command_Line_Compilers (Base : in out Knowledge_Base; On_Target : Targets_Set_Id; Filters : Compiler_Lists.List; Compilers : in out Compiler_Lists.List; Target_Specified : Boolean; Selected_Target : in out Unbounded_String); -- In batch mode, the --config parameters indicate what compilers should be -- selected. Each of these switch selects the first matching compiler -- available, and all --config switch must match a compiler. -- The information provided by the user does not have to be complete, and -- this procedure completes all missing information like version, runtime, -- and so on. -- In gprconfig, it should only be called in batch mode, since otherwise -- --config only acts as a filter for the compilers that are found through -- the knowledge base. -- Filters is the list specified by the user as --config, and contains -- potentially partial information for each compiler. On output, Compilers -- is completed with the full information for all compilers in Filters. If -- at least one of the compilers in Filters cannot be found, Invalid_Config -- is raised. function Extra_Dirs_From_Filters (Filters : Compiler_Lists.List) return String; -- Compute the list of directories that should be prepended to the PATH -- when searching for compilers. These are all the directories that the -- user has explicitly specified in his filters (aka --config) ----------------------------- -- knowledge base contents -- ----------------------------- package Variables_Maps renames Name_Id_Maps; No_Compiler : constant Compiler; -- Describes one of the compilers found on the PATH. -- Path is the directory that contains the compiler executable. -- Path_Order is used for sorting in the interactive menu: it indicates the -- index in $PATH of the directory, so that we can show first the compilers -- that are first in path. -- Any of these compilers can be selected by the user as part of a config. -- However, to prevent incompatibilities, a compiler can be marked as not -- selectable. This will be re-evaluated based on the current selection. -- Complete is set to True if all the information about the compiler was -- computed. It is set to False if the compiler was specified through a -- command line argument --config, and part of the info needs to be -- computed. -- Index_In_List is used for the interactive menu, and is initialized -- automatically. type Compiler_Iterator is abstract tagged null record; -- An iterator that searches for all known compilers in a list of -- directories. Whenever a new compiler is found, the Callback primitive -- operation is called. procedure Callback (Iterator : in out Compiler_Iterator; Base : in out Knowledge_Base; Comp : Compiler; Runtime_Specified : Boolean; From_Extra_Dir : Boolean; Continue : out Boolean) is abstract; -- Called whenever a new compiler is discovered. -- It might be discovered either in a path added through a --config -- parameter (in which case From_Extra_Dir is True), or in a path specified -- in the environment variable $PATH (in which case it is False). If the -- directory is both in Extra_Dirs and in $PATH, From_Extra_Dir is set to -- False. -- If Runtime_Specified is True, only filters with a specified runtime are -- -- On exit, Continue should be set to False if there is no need to discover -- further compilers (however there will be no possibility to restart the -- search at the same point later on). procedure Foreach_Compiler_In_Path (Iterator : in out Compiler_Iterator; Base : in out Knowledge_Base; On_Target : Targets_Set_Id; Extra_Dirs : String := ""); -- Find all compilers in "Extra_Dirs & $PATH". -- Extra_Dirs should typically be the list of directories found in -- --config command line arguments. -- The only filtering done is the target, for optimization purposes (no -- need to computed all info about the compiler if we know it will not be -- uses anyway). procedure Known_Compiler_Names (Base : Knowledge_Base; List : out Ada.Strings.Unbounded.Unbounded_String); -- Set List to the comma-separated list of known compilers procedure Generate_Configuration (Base : Knowledge_Base; Compilers : Compiler_Lists.List; Output_File : String; Target : String; Selected_Targets_Set : Targets_Set_Id); -- Generate the configuration file for the list of selected compilers type Double_String is record Positive_Regexp : Unbounded_String; Negative_Regexp : Unbounded_String; end record; package Double_String_Lists is new Ada.Containers.Doubly_Linked_Lists (Double_String); use Double_String_Lists; procedure Put_Verbose (Str : String; Indent_Delta : Integer := 0); -- Print Str if verbose mode is activated. -- Indent_Delta will increase the current indentation level for all further -- traces, which is used to highlight nested calls. Only the sign of -- Indent_Delta is taken into account. -- Nothing is printed if Str is the empty string, only the indentation is -- changed function Filter_Match (Base : Knowledge_Base; Comp : Compiler; Filter : Compiler) return Boolean; -- Returns True if Comp match Filter (the latter corresponds to a --config -- command line argument). private type Targets_Set_Id is range -1 .. Natural'Last; All_Target_Sets : constant Targets_Set_Id := -1; Unknown_Targets_Set : constant Targets_Set_Id := 0; type Compiler is record Name : Name_Id := No_Name; -- The name of the compiler, as specified in the node of the -- knowledge base. If Compiler represents a filter as defined on through -- --config switch, then name can also be the base name of the -- executable we are looking for. In such a case, it never includes the -- exec suffix (.exe on Windows) Executable : Name_Id := No_Name; Target : Name_Id := No_Name; Targets_Set : Targets_Set_Id; Path : Name_Id := No_Name; Base_Name : Name_Id := No_Name; -- Base name of the executable. This does not include the exec suffix Version : Name_Id := No_Name; Variables : Variables_Maps.Map; Prefix : Name_Id := No_Name; Runtime : Name_Id := No_Name; Alt_Runtime : Name_Id := No_Name; Runtime_Dir : Name_Id := No_Name; Default_Runtime : Boolean := False; Any_Runtime : Boolean := False; Path_Order : Integer; Language_Case : Name_Id := No_Name; -- The supported language, with the casing read from the compiler. This -- is for display purposes only Language_LC : Name_Id := No_Name; -- The supported language, always lower case Selectable : Boolean := True; Selected : Boolean := False; Complete : Boolean := True; end record; No_Compiler : constant Compiler := (Name => No_Name, Target => No_Name, Targets_Set => Unknown_Targets_Set, Executable => No_Name, Base_Name => No_Name, Path => No_Name, Variables => Variables_Maps.Empty_Map, Version => No_Name, Prefix => No_Name, Runtime => No_Name, Alt_Runtime => No_Name, Default_Runtime => False, Any_Runtime => False, Runtime_Dir => No_Name, Language_Case => No_Name, Language_LC => No_Name, Selectable => False, Selected => False, Complete => True, Path_Order => 0); type Pattern_Matcher_Access is access all GNAT.Regpat.Pattern_Matcher; type External_Value_Type is (Value_Constant, Value_Shell, Value_Directory, Value_Grep, Value_Nogrep, Value_Filter, Value_Must_Match, Value_Variable, Value_Done); type External_Value_Node (Typ : External_Value_Type := Value_Constant) is record case Typ is when Value_Constant => Value : Name_Id; when Value_Shell => Command : Name_Id; when Value_Directory => Directory : Name_Id; Directory_Group : Integer; Dir_If_Match : Name_Id; Contents : Pattern_Matcher_Access; when Value_Grep => Regexp_Re : Pattern_Matcher_Access; Group : Natural; when Value_Nogrep => Regexp_No : Pattern_Matcher_Access; when Value_Filter => Filter : Name_Id; when Value_Must_Match => Must_Match : Name_Id; when Value_Variable => Var_Name : Name_Id; when Value_Done => null; end case; end record; package External_Value_Nodes is new Ada.Containers.Doubly_Linked_Lists (External_Value_Node); subtype External_Value is External_Value_Nodes.List; Null_External_Value : constant External_Value := External_Value_Nodes.Empty_List; type Compiler_Description is record Name : Name_Id := No_Name; Executable : Name_Id := No_Name; Executable_Re : Pattern_Matcher_Access; Prefix_Index : Integer := -1; Target : External_Value; Version : External_Value; Variables : External_Value; Languages : External_Value; Runtimes : External_Value; Default_Runtimes : String_Lists.List; end record; -- Executable_Re is only set if the name of the must be -- taken as a regular expression. package Compiler_Description_Maps is new Ada.Containers.Hashed_Maps (Name_Id, Compiler_Description, To_Hash, "="); type Compiler_Filter is record Name : Name_Id; Name_Re : Pattern_Matcher_Access; Version : Name_Id; Version_Re : Pattern_Matcher_Access; Runtime : Name_Id; Runtime_Re : Pattern_Matcher_Access; Language_LC : Name_Id; end record; -- Representation for a node (in ) package Compiler_Filter_Lists is new Ada.Containers.Doubly_Linked_Lists (Compiler_Filter); type Compilers_Filter is record Compiler : Compiler_Filter_Lists.List; Negate : Boolean := False; end record; No_Compilers_Filter : constant Compilers_Filter := (Compiler => Compiler_Filter_Lists.Empty_List, Negate => False); -- a filter, that matches if any of its child -- matches. package Compilers_Filter_Lists is new Ada.Containers.Doubly_Linked_Lists (Compilers_Filter); type Configuration is record Compilers_Filters : Compilers_Filter_Lists.List; Targets_Filters : Double_String_Lists.List; -- these are regexps Negate_Targets : Boolean := False; Config : Name_Id; Supported : Boolean; -- Whether the combination of compilers is supported end record; package Configuration_Lists is new Ada.Containers.Doubly_Linked_Lists (Configuration); package Target_Lists is new Ada.Containers.Doubly_Linked_Lists (Pattern_Matcher_Access); type Target_Set_Description is record Name : Name_Id; Patterns : Target_Lists.List; end record; subtype Known_Targets_Set_Id is Targets_Set_Id range 1 .. Targets_Set_Id'Last; -- Known targets set. They are in the base package Targets_Set_Vectors is new Ada.Containers.Vectors (Known_Targets_Set_Id, Target_Set_Description, "="); package Fallback_Targets_Set_Vectors is new Ada.Containers.Vectors (Known_Targets_Set_Id, String_Lists.List, String_Lists."="); type Knowledge_Base is record Compilers : Compiler_Description_Maps.Map; No_Compilers : String_Lists.List; Check_Executable_Regexp : Boolean := False; Configurations : Configuration_Lists.List; Targets_Sets : Targets_Set_Vectors.Vector; Fallback_Targets_Sets : Fallback_Targets_Set_Vectors.Vector; end record; -- Check_Executable_Regexp is set to True if at least some of the -- executable names are specified as regular expressions. In such a case, -- a slightly slower algorithm is used to search for compilers. -- No_Compilers is the list of languages that require no compiler, and thus -- should not be searched on the PATH. end GPR.Knowledge;