------------------------------------------------------------------------------
-- --
-- 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;