------------------------------------------------------------------------------
-- --
-- GPR PROJECT MANAGER --
-- --
-- Copyright (C) 2001-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 --
-- . --
-- --
------------------------------------------------------------------------------
-- The following package declares the data types for GNAT project.
-- These data types may be used by GNAT Project-aware tools.
-- Children of this package implement various services on these data types
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Containers.Ordered_Sets;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Dynamic_Tables;
pragma Warnings (Off);
with GNAT.OS_Lib; use GNAT.OS_Lib;
with System.Storage_Elements;
package GPR is
EOF : constant Character := ASCII.SUB;
-- The character SUB (16#1A#) is used in DOS and other systems derived
-- from DOS (XP, NT etc) to signal the end of a text file. Internally all
-- source files are ended by an EOF character, even on Unix systems. An EOF
-- character acts as the end of file only as the last character of a source
-- buffer, in any other position, it is treated as a blank if it appears
-- between tokens, and as an illegal character otherwise. This makes
-- life easier dealing with files that originated from DOS, including
-- concatenated files with interspersed EOF characters.
-----------
-- Types --
-----------
-------------------------------
-- General Use Integer Types --
-------------------------------
type Int is range -2 ** 31 .. +2 ** 31 - 1;
-- Signed 32-bit integer
subtype Nat is Int range 0 .. Int'Last;
-- Non-negative Int values
subtype Pos is Int range 1 .. Int'Last;
-- Positive Int values
type Word is mod 2 ** 32;
-- Unsigned 32-bit integer
type size_t is mod 2 ** Standard'Address_Size;
subtype Upper_Half_Character is
Character range Character'Val (16#80#) .. Character'Val (16#FF#);
-- 8-bit Characters with the upper bit set
subtype Graphic_Character is Character range ' ' .. '~';
-- Graphic characters, as defined in Ada Reference Manual
subtype Line_Terminator is Character range ASCII.LF .. ASCII.CR;
-- Line terminator characters (LF, VT, FF, CR)
type Source_Ptr is new Int;
-- Type used to represent a source location, which is a subscript of a
-- character in the source buffer. As noted above, different source buffers
-- have different ranges, so it is possible to tell from a Source_Ptr value
-- which source it refers to. Note that negative numbers are allowed to
-- accommodate the following special values.
No_Location : constant Source_Ptr := -1;
-- Value used to indicate no source position set in a node. A test for a
-- Source_Ptr value being > No_Location is the approved way to test for a
-- standard value that does not include No_Location or any of the following
-- special definitions. One important use of No_Location is to label
-- generated nodes that we don't want the debugger to see in normal mode
-- (very often we conditionalize so that we set No_Location in normal mode
-- and the corresponding source line in -gnatD mode).
First_Source_Ptr : constant Source_Ptr := 0;
-- Starting source pointer index value for first source program
type Source_File_Index is new Int range -1 .. Int'Last;
-- Type used to index the source file table (see package GPR.Sinput)
No_Source_File : constant Source_File_Index := 0;
-- Value used to indicate no source file present
-----------
-- Nodes --
-----------
type Node_Id is range 0 .. 99_999_999;
-- Type used to identify nodes in the tree
Empty_Node : constant Node_Id := 0;
-- Used to indicate null node. A node is actually allocated with this Id
-- value, so that Nkind (Empty) = N_Empty. Note that Node_Low_Bound is
-- zero, so Empty = No_List = zero.
Error_Node : constant Node_Id := 1;
-- Used to indicate an error in the source program. A node is actually
-- allocated with this Id value, so that Nkind (Error) = N_Error.
First_Node_Id : constant Node_Id := 0;
-- Subscript of first allocated node. Note that Empty and Error are both
-- allocated nodes, whose Nkind fields can be accessed without error.
Unrecoverable_Error : exception;
-------------------
-- Project nodes --
-------------------
Project_Nodes_Initial : constant := 1_000;
Project_Nodes_Increment : constant := 100;
-- Allocation parameters for initializing and extending number
-- of nodes in table Tree_Private_Part.Project_Nodes
Project_Node_Low_Bound : constant := 0;
Project_Node_High_Bound : constant := 099_999_999;
-- Range of values for project node id's (in practice infinite)
type Project_Node_Id is range
Project_Node_Low_Bound .. Project_Node_High_Bound;
-- The index of table Tree_Private_Part.Project_Nodes
Empty_Project_Node : constant Project_Node_Id := Project_Node_Low_Bound;
-- Designates no node in table Project_Nodes
First_Project_Node_Id : constant Project_Node_Id :=
Project_Node_Low_Bound + 1;
type Response_File_Format is
(None,
GNU,
Object_List,
Option_List,
GCC,
GCC_GNU,
GCC_Object_List,
GCC_Option_List);
-- The format of the different response files
------------
-- Stamps --
------------
package Stamps is
-----------------------------------
-- Representation of Time Stamps --
-----------------------------------
-- All compiled units are marked with a time stamp which is derived from
-- the source file (we assume that the host system has the concept of a
-- file time stamp which is modified when a file is modified). These
-- time stamps are used to ensure consistency of the set of units that
-- constitutes a library. Time stamps are 14-character strings with
-- with the following format:
-- YYYYMMDDHHMMSS
-- YYYY year
-- MM month (2 digits 01-12)
-- DD day (2 digits 01-31)
-- HH hour (2 digits 00-23)
-- MM minutes (2 digits 00-59)
-- SS seconds (2 digits 00-59)
-- In the case of Unix systems (and other systems which keep the time in
-- GMT), the time stamp is the GMT time of the file, not the local time.
-- This solves problems in using libraries across networks with clients
-- spread across multiple time-zones.
Time_Stamp_Length : constant := 14;
-- Length of time stamp value
subtype Time_Stamp_Index is Natural range 1 .. Time_Stamp_Length;
type Time_Stamp_Type is new String (Time_Stamp_Index);
-- Type used to represent time stamp
Empty_Time_Stamp : constant Time_Stamp_Type := (others => ' ');
-- Value representing an empty or missing time stamp. Looks less than
-- any real time stamp if two time stamps are compared. Note that
-- although this is not private, clients should not rely on the exact
-- way in which this string is represented, and instead should use the
-- subprograms below.
-- Note : the Empty_Time_Stamp value less than any non-empty time stamp
-- value.
Dummy_Time_Stamp : constant Time_Stamp_Type := (others => '0');
-- This is used for dummy time stamp values used in the D lines for
-- non-existent files, and is intended to be an impossible value.
end Stamps;
use Stamps;
--------------------
-- Default Output --
--------------------
type Section_Type is (Setup, Compile, Build_Libraries, Bind, Link);
-- Different sections in the default output, when switches -q and -v are
-- not used.
procedure Set (Section : Section_Type);
-- Indicate that the section header does not need to be output again.
-- This is used by gprbind and gprlib to avoid display the section header
-- again.
procedure Display
(Section : Section_Type;
Command : String;
Argument : String);
-- Display a command in the standard output. Display first the section
-- header if it has not been already displayed.
--------------------
type Name_Id is range 0 .. 99_999_999;
No_Name : constant Name_Id := 0;
Error_Name : constant Name_Id := 1;
First_Name_Id : constant Name_Id := 2;
-- Subscript of first entry in names table
package Name_Id_Set is new Ada.Containers.Ordered_Sets (Name_Id);
type Unit_Name_Type is new Name_Id;
-- Unit names are stored in the names table and this type is used to
-- indicate that a Name_Id value is being used to hold a unit name,
-- which terminates in %b for a body or %s for a spec.
No_Unit_Name : constant Unit_Name_Type := Unit_Name_Type (No_Name);
-- Constant used to indicate no file name present
Error_Unit_Name : constant Unit_Name_Type := Unit_Name_Type (Error_Name);
-- The special Unit_Name_Type value Error_Unit_Name is used to indicate
-- a unit name where some previous processing has found an error.
package String_Sets is new Ada.Containers.Indefinite_Ordered_Sets (String);
------------------------------
-- File and Path Name Types --
------------------------------
type File_Name_Type is new Name_Id;
-- File names are stored in the names table and this type is used to
-- indicate that a Name_Id value is being used to hold a simple file
-- name (which does not include any directory information).
No_File : constant File_Name_Type := File_Name_Type (No_Name);
-- Constant used to indicate no file is present (this is used for
-- example when a search for a file indicates that no file of the
-- name exists).
Error_File_Name : constant File_Name_Type := File_Name_Type (Error_Name);
-- The special File_Name_Type value Error_File_Name is used to indicate
-- a unit name where some previous processing has found an error.
type Path_Name_Type is new Name_Id;
-- Path names are stored in the names table and this type is used to
-- indicate that a Name_Id value is being used to hold a path name (that
-- may contain directory information).
No_Path : constant Path_Name_Type := Path_Name_Type (No_Name);
-- Constant used to indicate no path name is present
File_Attributes_Size : constant Natural := 32;
type File_Attributes is
array (1 .. File_Attributes_Size)
of System.Storage_Elements.Storage_Element;
for File_Attributes'Alignment use Standard'Maximum_Alignment;
-- A cache for various attributes for a file (length, accessibility,...)
-- This must be initialized to Unknown_Attributes prior to the first call.
Unknown_Attributes : File_Attributes := (others => 0);
-- A cache for various attributes for a file (length, accessibility,...)
-- Will be initialized properly at elaboration (for efficiency later on,
-- avoid function calls every time we want to reset the attributes) prior
-- to the first usage. We cannot make it constant since the compiler may
-- put it in a read-only section.
Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";
Project_Include_Path_File : constant String := "ADA_PRJ_INCLUDE_FILE";
Project_Objects_Path_File : constant String := "ADA_PRJ_OBJECTS_FILE";
procedure Add_Restricted_Language (Name : String);
-- Call by gprbuild for each language specified by switch
-- --restricted-to-languages=.
procedure Remove_All_Restricted_Languages;
-- Call by gprbuild in CodePeer mode to ignore switches
-- --restricted-to-languages=.
function Is_Allowed_Language (Name : Name_Id) return Boolean;
-- Returns True if --restricted-to-languages= is not used or if Name
-- is one of the restricted languages.
function Languages_Are_Restricted return Boolean;
-- Returns True iff the list of restricted languages is not empty.
All_Other_Names : constant Name_Id := Name_Id'Last;
-- Name used to replace others as an index of an associative array
-- attribute in situations where this is allowed.
Subdirs : String_Access := null;
-- The value after the equal sign in switch --subdirs=...
-- Contains the relative subdirectory.
Src_Subdirs : String_Access := null;
-- The value after the equal sign in switch --src-subdirs=...
-- Contains the relative subdirectory.
Build_Tree_Dir : String_Access := null;
-- A root directory for building out-of-tree projects. All relative object
-- directories will be rooted at this location.
Root_Dir : String_Access := null;
-- When using out-of-tree build we need to keep information about the root
-- directory of artifacts to properly relocate them. Note that the root
-- directory is not necessarily the directory of the main project.
type Library_Support is (None, Static_Only, Full);
-- Support for Library Project File.
-- - None: Library Project Files are not supported at all
-- - Static_Only: Library Project Files are only supported for static
-- libraries.
-- - Full: Library Project Files are supported for static and dynamic
-- (shared) libraries.
type Yes_No_Unknown is (Yes, No, Unknown);
-- Tri-state to decide if -lgnarl is needed when linking
type Attribute_Default_Value is
(Read_Only_Value, -- For read only attributes (Name,Project_Dir)
Empty_Value, -- Empty string or empty string list
Dot_Value, -- "." or (".")
Object_Dir_Value, -- 'Object_Dir
Target_Value, -- 'Target (special rules)
Runtime_Value, -- 'Runtime (special rules)
Canonical_Target_Value); -- 'Canonical_Target (special rules)
-- Describe the default values of attributes that are referenced but not
-- declared.
pragma Warnings (Off);
type Project_Qualifier is
(Unspecified,
-- The following clash with Standard is OK, and justified by the context
-- which really wants to use the same set of qualifiers.
Standard,
Library,
Configuration,
Abstract_Project,
Aggregate,
Aggregate_Library);
pragma Warnings (On);
-- Qualifiers that can prefix the reserved word "project" in a project
-- file:
-- Standard: standard project ...
-- Library: library project is ...
-- Abstract_Project: abstract project is
-- Aggregate: aggregate project is
-- Aggregate_Library: aggregate library project is ...
-- Configuration: configuration project is ...
subtype Aggregate_Project is
Project_Qualifier range Aggregate .. Aggregate_Library;
All_Packages : constant String_List_Access;
-- Default value of parameter Packages of procedures Parse, in Prj.Pars and
-- Prj.Part, indicating that all packages should be checked.
type Project_Tree_Data;
type Project_Tree_Ref is access all Project_Tree_Data;
-- Reference to a project tree. Several project trees may exist in memory
-- at the same time.
No_Project_Tree : constant Project_Tree_Ref;
procedure Free (Tree : in out Project_Tree_Ref);
-- Free memory associated with the tree
Config_Project_File_Extension : String := ".cgpr";
Project_File_Extension : String := ".gpr";
-- The standard config and user project file name extensions. They are not
-- constants, because Canonical_Case_File_Name is called on these variables
-- in the body of Prj.
GNAT_And_Space : constant String := "GNAT ";
function Empty_File return File_Name_Type with Inline_Always;
function Empty_String return Name_Id with Inline_Always;
-- Return the id for an empty string ""
function Dot_String return Name_Id with Inline_Always;
-- Return the id for "."
type Path_Information is record
Name : Path_Name_Type := No_Path;
Display_Name : Path_Name_Type := No_Path;
end record;
-- Directory names always end with a directory separator
No_Path_Information : constant Path_Information := (No_Path, No_Path);
type Project_Data;
type Project_Id is access all Project_Data;
No_Project : constant Project_Id := null;
-- Id of a Project File
type String_List_Id is new Nat;
Nil_String : constant String_List_Id := 0;
type String_Element is record
Value : Name_Id := No_Name;
Index : Int := 0;
Display_Value : Name_Id := No_Name;
Location : Source_Ptr := No_Location;
Next : String_List_Id := Nil_String;
end record;
-- To hold values for string list variables and array elements.
package String_Element_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => String_Element,
Table_Index_Type => String_List_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table for string elements in string lists
type Variable_Kind is (Undefined, List, Single);
-- Different kinds of variables
subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
-- The defined kinds of variables
Ignored : constant Variable_Kind;
-- Used to indicate that a package declaration must be ignored while
-- processing the project tree (unknown package name).
type Variable_Value (Kind : Variable_Kind := Undefined) is record
Project : Project_Id := No_Project;
Location : Source_Ptr := No_Location;
String_Type : Project_Node_Id := Empty_Project_Node;
Default : Boolean := False;
From_Implicit_Target : Boolean := False;
case Kind is
when Undefined =>
null;
when List =>
Values : String_List_Id := Nil_String;
Concat : Boolean := False;
when Single =>
Value : Name_Id := No_Name;
Index : Int := 0;
end case;
end record;
-- Values for variables and array elements. Default is True if the
-- current value is the default one for the variable. String_Type is
-- Empty_Project_Node, except for typed variables where it designates
-- the string type node.
--
-- From_Implicit_Target is only changed to True when evaluating
-- an expression that depends on 'Target reference, and the target is not
-- explicitly declared in corresponding project. In such case the 'Target
-- is still evaluated to normalized hostname, however at configuration
-- phase it is not possible to distinguish this case from real explicit
-- native target specification. So if in root project we have
-- for Target use Imported_Project'Target;
-- and Imported_Project has no explicit target declaration it is otherwise
-- not possible to understand that target fallback if needed.
Nil_Variable_Value : constant Variable_Value;
-- Value of a non existing variable or array element
type Variable_Id is new Nat;
No_Variable : constant Variable_Id := 0;
type Variable is record
Next : Variable_Id := No_Variable;
Name : Name_Id;
Value : Variable_Value;
end record;
-- To hold the list of variables in a project file and in packages
package Variable_Element_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Variable,
Table_Index_Type => Variable_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table of variable in list of variables
type Array_Element_Id is new Nat;
No_Array_Element : constant Array_Element_Id := 0;
type Array_Element is record
Index : Name_Id;
Restricted : Boolean := False;
Src_Index : Int := 0;
Index_Case_Sensitive : Boolean := True;
Value : Variable_Value;
Next : Array_Element_Id := No_Array_Element;
end record;
-- Each Array_Element represents an array element and is linked (Next)
-- to the next array element, if any, in the array.
package Array_Element_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Array_Element,
Table_Index_Type => Array_Element_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table that contains all array elements
type Array_Id is new Nat;
No_Array : constant Array_Id := 0;
type Array_Data is record
Name : Name_Id := No_Name;
Location : Source_Ptr := No_Location;
Value : Array_Element_Id := No_Array_Element;
Next : Array_Id := No_Array;
end record;
-- Each Array_Data value represents an array.
-- Value is the id of the first element.
-- Next is the id of the next array in the project file or package.
package Array_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Array_Data,
Table_Index_Type => Array_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100);
-- The table that contains all arrays
type Package_Id is new Nat;
No_Package : constant Package_Id := 0;
type Declarations is record
Variables : Variable_Id := No_Variable;
Attributes : Variable_Id := No_Variable;
Arrays : Array_Id := No_Array;
Packages : Package_Id := No_Package;
end record;
-- Contains the declarations (variables, single and array attributes,
-- packages) for a project or a package in a project.
No_Declarations : constant Declarations :=
(Variables => No_Variable,
Attributes => No_Variable,
Arrays => No_Array,
Packages => No_Package);
-- Default value of Declarations: used if there are no declarations
type Package_Element is record
Name : Name_Id := No_Name;
Decl : Declarations := No_Declarations;
Parent : Package_Id := No_Package;
Next : Package_Id := No_Package;
end record;
-- A package (includes declarations that may include other packages)
package Package_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Package_Element,
Table_Index_Type => Package_Id,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100);
-- The table that contains all packages
type Language_Data;
type Language_Ptr is access all Language_Data;
-- Index of language data
No_Language_Index : constant Language_Ptr := null;
-- Constant indicating that there is no language data
function Get_Language_From_Name
(Project : Project_Id;
Name : String) return Language_Ptr;
-- Get a language from a project. This might return null if no such
-- language exists in the project
Max_Header_Num : constant := 6150;
type Header_Num is range 0 .. Max_Header_Num;
-- Size for hash table below. The upper bound is an arbitrary value, the
-- value here was chosen after testing to determine a good compromise
-- between speed of access and memory usage.
function Hash (Name : Name_Id) return Header_Num;
function Hash (Name : File_Name_Type) return Header_Num;
function Hash (Name : Path_Name_Type) return Header_Num;
function Hash (Project : Project_Id) return Header_Num;
-- Used for computing hash values for names put into hash tables
type Language_Kind is (File_Based, Unit_Based);
-- Type for the kind of language. All languages are file based, except Ada
-- which is unit based.
-- Type of dependency to be checked
type Dependency_File_Kind is
(None,
-- There is no dependency file, the source must always be recompiled
Makefile,
-- The dependency file is a Makefile fragment indicating all the files
-- the source depends on. If the object file or the dependency file is
-- more recent than any of these files, the source must be recompiled.
ALI_File,
-- The dependency file is an ALI file and the source must be recompiled
-- if the object or ALI file is more recent than any of the sources
-- listed in the D lines.
ALI_Closure);
-- The dependency file is an ALI file and the source must be recompiled
-- if the object or ALI file is more recent than any source in the full
-- closure.
subtype ALI_Dependency is
Dependency_File_Kind range ALI_File .. ALI_Closure;
Makefile_Dependency_Suffix : constant String := ".d";
ALI_Dependency_Suffix : constant String := ".ali";
Switches_Dependency_Suffix : constant String := ".cswi";
Binder_Exchange_Suffix : constant String := ".bexch";
-- Suffix for binder exchange files
Library_Exchange_Suffix : constant String := ".lexch";
-- Suffix for library exchange files
type Name_List_Index is new Nat;
No_Name_List : constant Name_List_Index := 0;
type Name_Node is record
Name : Name_Id := No_Name;
Next : Name_List_Index := No_Name_List;
end record;
package Name_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Node,
Table_Index_Type => Name_List_Index,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100);
-- The table for lists of names
function Length
(Table : Name_List_Table.Instance;
List : Name_List_Index) return Natural;
-- Return the number of elements in specified list
type Number_List_Index is new Nat;
No_Number_List : constant Number_List_Index := 0;
type Number_Node is record
Number : Natural := 0;
Next : Number_List_Index := No_Number_List;
end record;
package Number_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Number_Node,
Table_Index_Type => Number_List_Index,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100);
-- The table for lists of numbers
package Mapping_Files_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Path_Name_Type,
No_Element => No_Path,
Key => Path_Name_Type,
Hash => Hash,
Equal => "=");
-- A hash table to store the mapping files that are not used
-- The following record ???
type Casing_Type is (
All_Upper_Case,
-- All letters are upper case
All_Lower_Case,
-- All letters are lower case
Mixed_Case,
-- The initial letter, and any letters after underlines are upper case.
-- All other letters are lower case
Unknown
-- Used if an identifier does not distinguish between the above cases,
-- (e.g. X, Y_3, M4, A_B, or if it is inconsistent ABC_def).
);
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
-- Exclude Unknown casing
type Lang_Naming_Data is record
Dot_Replacement : File_Name_Type := No_File;
-- The string to replace '.' in the source file name (for Ada)
Casing : Casing_Type := All_Lower_Case;
-- The casing of the source file name (for Ada)
Separate_Suffix : File_Name_Type := No_File;
-- String to append to unit name for source file name of an Ada subunit
Spec_Suffix : File_Name_Type := No_File;
-- The string to append to the unit name for the
-- source file name of a spec.
Body_Suffix : File_Name_Type := No_File;
-- The string to append to the unit name for the
-- source file name of a body.
end record;
No_Lang_Naming_Data : constant Lang_Naming_Data := (others => <>);
function Is_Standard_GNAT_Naming (Naming : Lang_Naming_Data) return Boolean;
-- True if the naming scheme is GNAT's default naming scheme. This
-- is to take into account shortened names like "Ada." (a-), "System." (s-)
-- and so on.
type Source_Data;
type Source_Id is access all Source_Data;
function Is_Compilable (Source : Source_Id) return Boolean;
pragma Inline (Is_Compilable);
-- Return True if we know how to compile Source (i.e. if a compiler is
-- defined). This doesn't indicate whether the source should be compiled.
function Object_To_Global_Archive (Source : Source_Id) return Boolean;
pragma Inline (Object_To_Global_Archive);
-- Return True if the object file should be put in the global archive.
-- This is for Ada, when only the closure of a main needs to be
-- (re)compiled.
function Other_Part (Source : Source_Id) return Source_Id;
pragma Inline (Other_Part);
-- Source ID for the other part, if any: for a spec, returns its body;
-- for a body, returns its spec.
No_Source : constant Source_Id := null;
-- The following record describes the configuration of a language
type Language_Config is record
Kind : Language_Kind := File_Based;
-- Kind of language. Most languages are file based. A few, such as Ada,
-- are unit based.
Naming_Data : Lang_Naming_Data;
-- The naming data for the languages (prefixes, etc.)
Include_Compatible_Languages : Name_List_Index := No_Name_List;
-- List of languages that are "include compatible" with this language. A
-- language B (for example "C") is "include compatible" with a language
-- A (for example "C++") if it is expected that sources of language A
-- may "include" header files from language B.
Compiler_Driver : File_Name_Type := No_File;
-- The name of the executable for the compiler of the language
Compiler_Driver_Path : String_Access := null;
-- The path name of the executable for the compiler of the language
Compiler_Leading_Required_Switches : Name_List_Index := No_Name_List;
-- The list of initial switches that are required as a minimum to invoke
-- the compiler driver.
Compiler_Trailing_Required_Switches : Name_List_Index := No_Name_List;
-- The list of final switches that are required as a minimum to invoke
-- the compiler driver.
Multi_Unit_Switches : Name_List_Index := No_Name_List;
-- The switch(es) to indicate the index of a unit in a multi-source file
Multi_Unit_Object_Separator : Character := ' ';
-- The string separating the base name of a source from the index of the
-- unit in a multi-source file, in the object file name.
Source_File_Switches : Name_List_Index := No_Name_List;
-- Optional switches to be put before the source file. The source file
-- path name is appended to the last switch in the list.
-- Example: ("-i", "");
Object_File_Suffix : Name_Id := No_Name;
-- Optional alternate object file suffix
Object_File_Switches : Name_List_Index := No_Name_List;
-- Optional object file switches. When this is defined, the switches
-- are used to specify the object file. The object file name is appended
-- to the last switch in the list. Example: ("-o", "").
Object_Path_Switches : Name_List_Index := No_Name_List;
-- List of switches to specify to the compiler the path name of a
-- temporary file containing the list of object directories in the
-- correct order.
Compilation_PIC_Option : Name_List_Index := No_Name_List;
-- The option(s) to compile a source in Position Independent Code for
-- shared libraries. Specified in the configuration. When not specified,
-- there is no need for such switch.
Object_Generated : Boolean := True;
-- False if no object file is generated
Objects_Linked : Boolean := True;
-- False if object files are not use to link executables and build
-- libraries.
Runtime_Dir : Name_Id := No_Name;
-- Path name of the runtime directory, if any
Runtime_Library_Dirs : Name_List_Index := No_Name_List;
-- Path names of the runtime library directories, if any
Runtime_Source_Dirs : Name_List_Index := No_Name_List;
-- Path names of the runtime source directories, if any
Runtime_Library_Version : Name_Id := No_Name;
-- Value of the library version
Mapping_File_Switches : Name_List_Index := No_Name_List;
-- The option(s) to provide a mapping file to the compiler. Specified in
-- the configuration. When value is No_Name_List, there is no mapping
-- file.
Mapping_Spec_Suffix : File_Name_Type := No_File;
-- Placeholder representing the spec suffix in a mapping file
Mapping_Body_Suffix : File_Name_Type := No_File;
-- Placeholder representing the body suffix in a mapping file
Config_File_Switches : Name_List_Index := No_Name_List;
-- The option(s) to provide a config file to the compiler. Specified in
-- the configuration. If value is No_Name_List there is no config file.
Dependency_Kind : Dependency_File_Kind := None;
-- The kind of dependency to be checked: none, Makefile fragment or
-- ALI file (for Ada).
Dependency_Option : Name_List_Index := No_Name_List;
-- The option(s) to be used to create the dependency file. When value is
-- No_Name_List, there is not such option(s).
Compute_Dependency : Name_List_Index := No_Name_List;
-- Hold the value of attribute Dependency_Driver, if declared for the
-- language.
Include_Option : Name_List_Index := No_Name_List;
-- Hold the value of attribute Include_Switches, if declared for the
-- language.
Include_Path : Name_Id := No_Name;
-- Name of environment variable declared by attribute Include_Path for
-- the language.
Include_Switches_Via_Spec : Name_List_Index := No_Name_List;
-- Indicate the name of the underlying compiler and the switch to
-- specify an included source directory.
-- Used to invoke a GNU compiler with switch -specs, to avoid long
-- command lines.
Include_Path_File : Name_Id := No_Name;
-- Name of environment variable declared by attribute Include_Path_File
-- for the language.
Only_Dirs_With_Sources : Boolean := False;
-- When True, only the directories that contain sources of the language
-- are used as included directories when compiling.
Objects_Path : Name_Id := No_Name;
-- Name of environment variable declared by attribute Objects_Path for
-- the language.
Objects_Path_File : Name_Id := No_Name;
-- Name of environment variable declared by attribute Objects_Path_File
-- for the language.
Config_Body : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a specific
-- file name of a body.
Config_Body_Index : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a specific
-- file name of a body in a multi-source file.
Config_Body_Pattern : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a naming
-- body pattern.
Config_Spec : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a specific
-- file name of a spec.
Config_Spec_Index : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a specific
-- file name of a spec in a multi-source file.
Config_Spec_Pattern : Name_Id := No_Name;
-- The template for a pragma Source_File_Name(_Project) for a naming
-- spec pattern.
Config_File_Dependency_Support : Boolean := True;
-- True if dependency of the source files from config file is supported
Config_File_Unique : Boolean := False;
-- True if the config file specified to the compiler needs to be unique.
-- If it is unique, then all config files are concatenated into a temp
-- config file.
Binder_Driver : File_Name_Type := No_File;
-- The name of the binder driver for the language, if any
Binder_Driver_Path : Path_Name_Type := No_Path;
-- The path name of the binder driver
Binder_Required_Switches : Name_List_Index := No_Name_List;
-- Hold the value of attribute Binder'Required_Switches for the language
Binder_Prefix : Name_Id := No_Name;
-- Hold the value of attribute Binder'Prefix for the language
Toolchain_Version : Name_Id := No_Name;
-- Hold the value of attribute Toolchain_Version for the language
Required_Toolchain_Version : Name_Id := No_Name;
-- Hold the value of attribute Required_Toolchain_Version for the
-- language.
Toolchain_Description : Name_Id := No_Name;
-- Hold the value of attribute Toolchain_Description for the language
Clean_Object_Artifacts : Name_List_Index := No_Name_List;
-- List of object artifact extensions to be deleted by gprclean
Clean_Source_Artifacts : Name_List_Index := No_Name_List;
-- List of source artifact extensions to be deleted by gprclean
Resp_File_Format : Response_File_Format := None;
-- The format of a response file, when compiling with a response file is
-- supported.
Resp_File_Options : Name_List_Index := No_Name_List;
-- The switches, if any, that precede the path name of the response
-- file in the invocation of the compiler.
end record;
No_Language_Config : constant Language_Config := (others => <>);
type Language_Data is record
Name : Name_Id := No_Name;
-- The name of the language in lower case
Display_Name : Name_Id := No_Name;
-- The name of the language, as found in attribute Languages
Config : Language_Config := No_Language_Config;
-- Configuration of the language
First_Source : Source_Id := No_Source;
-- Head of the list of sources of the language in the project
Mapping_Files : Mapping_Files_Htable.Instance :=
Mapping_Files_Htable.Nil;
-- Hash table containing the mapping of the sources to their path names
Unconditional_Linking : Boolean := False;
-- All object files of this language should be linked unconditionally
Next : Language_Ptr := No_Language_Index;
-- Next language of the project
end record;
No_Language_Data : constant Language_Data := (others => <>);
type Language_List_Element;
type Language_List is access all Language_List_Element;
type Language_List_Element is record
Language : Language_Ptr := No_Language_Index;
Next : Language_List;
end record;
type Source_Kind is (Spec, Impl, Sep);
subtype Spec_Or_Body is Source_Kind range Spec .. Impl;
-- The following declarations declare a structure used to store the Name
-- and File and Path names of a unit, with a reference to its GNAT Project
-- File(s). Some units might have neither Spec nor Impl when they were
-- created for a "separate".
type File_Names_Data is array (Spec_Or_Body) of Source_Id;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
type Unit_Index is access all Unit_Data;
No_Unit_Index : constant Unit_Index := null;
-- Used to indicate a null entry for no unit
type Source_Roots;
type Roots_Access is access Source_Roots;
type Source_Roots is record
Root : Source_Id;
Next : Roots_Access;
end record;
-- A list to store the roots associated with a main unit. These are the
-- files that need to linked along with the main (for instance a C file
-- corresponding to an Ada file). In general, these are dependencies that
-- cannot be computed automatically by the builder.
type Naming_Exception_Type is (No, Yes, Inherited);
-- Structure to define source data
type Source_Data is record
Initialized : Boolean := False;
-- Set to True when Source_Data is completely initialized
Project : Project_Id := No_Project;
-- Project of the source
Location : Source_Ptr := No_Location;
-- Location in the project file of the declaration of the source in
-- package Naming.
Source_Dir_Rank : Natural := 0;
-- The rank of the source directory in list declared with attribute
-- Source_Dirs. Two source files with the same name cannot appears in
-- different directory with the same rank. That can happen when the
-- recursive notation
/** is used in attribute Source_Dirs.
Language : Language_Ptr := No_Language_Index;
-- Language of the source
In_Interfaces : Boolean := True;
-- False when the source is not included in interfaces, when attribute
-- Interfaces is declared.
In_Src_Subdir : Boolean := False;
-- If source is in the --src-subdir direcory it should be In_Interfaces
Declared_In_Interfaces : Boolean := False;
-- True when source is declared in attribute Interfaces
Alternate_Languages : Language_List := null;
-- List of languages a header file may also be, in addition of language
-- Language_Name.
Kind : Source_Kind := Spec;
-- Kind of the source: spec, body or subunit
Unit : Unit_Index := No_Unit_Index;
-- Name of the unit, if language is unit based. This is only set for
-- those files that are part of the compilation set (for instance a
-- file in an extended project that is overridden will not have this
-- field set).
Index : Int := 0;
-- Index of the source in a multi unit source file (the same Source_Data
-- is duplicated several times when there are several units in the same
-- file). Index is 0 if there is either no unit or a single one, and
-- starts at 1 when there are multiple units
Compilable : Yes_No_Unknown := Unknown;
-- Updated at the first call to Is_Compilable. Yes if source file is
-- compilable.
In_The_Queue : Boolean := False;
-- True if the source has been put in the queue
Locally_Removed : Boolean := False;
-- True if the source has been "excluded"
Suppressed : Boolean := False;
-- True if the source is a locally removed direct source of the project.
-- These sources should not be put in the mapping file.
Replaced_By : Source_Id := No_Source;
-- Source in an extending project that replaces the current source
File : File_Name_Type := No_File;
-- Canonical file name of the source
Display_File : File_Name_Type := No_File;
-- File name of the source, for display purposes
Path : Path_Information := No_Path_Information;
-- Path name of the source
Source_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Time stamp of the source file
Checksum : Word := 0;
-- Checksum calculated from source file
Checksum_Src : File_Name_Type := No_File;
-- Source of checksum.
-- No_File - No checksum
-- First_Name_Id - Calculated from source file
-- Other values - From dependency file of source simple name
Object_Project : Project_Id := No_Project;
-- Project where the object file is. This might be different from
-- Project when using extending project files.
Object : File_Name_Type := No_File;
-- File name of the object file
Current_Object_Path : Path_Name_Type := No_Path;
-- Object path of an existing object file
Object_Path : Path_Name_Type := No_Path;
-- Object path of the real object file
Object_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Object file time stamp
Dep_Name : File_Name_Type := No_File;
-- Dependency file simple name
Dep_Path : Path_Name_Type := No_Path;
-- Path name of the real dependency file
Dep_TS : aliased File_Attributes := Unknown_Attributes;
-- Dependency file time stamp
Switches : File_Name_Type := No_File;
-- File name of the switches file. For all languages, this is a file
-- that ends with the .cswi extension.
Switches_Path : Path_Name_Type := No_Path;
-- Path name of the switches file
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Switches file time stamp
Naming_Exception : Naming_Exception_Type := No;
-- True if the source has an exceptional name
Duplicate_Unit : Boolean := False;
-- True when a duplicate unit has been reported for this source
Next_In_Lang : Source_Id := No_Source;
-- Link to another source of the same language in the same project
Next_With_File_Name : Source_Id := No_Source;
-- Link to another source with the same base file name
Roots : Roots_Access := null;
-- The roots for a main unit
end record;
No_Source_Data : constant Source_Data :=
(Initialized => False,
Project => No_Project,
Location => No_Location,
Source_Dir_Rank => 0,
Language => No_Language_Index,
In_Interfaces => True,
Declared_In_Interfaces => False,
In_Src_Subdir => False,
Alternate_Languages => null,
Kind => Spec,
Unit => No_Unit_Index,
Index => 0,
Locally_Removed => False,
Suppressed => False,
Compilable => Unknown,
In_The_Queue => False,
Replaced_By => No_Source,
File => No_File,
Display_File => No_File,
Path => No_Path_Information,
Source_TS => Empty_Time_Stamp,
Checksum => 0,
Checksum_Src => No_File,
Object_Project => No_Project,
Object => No_File,
Current_Object_Path => No_Path,
Object_Path => No_Path,
Object_TS => Empty_Time_Stamp,
Dep_Name => No_File,
Dep_Path => No_Path,
Dep_TS => Unknown_Attributes,
Switches => No_File,
Switches_Path => No_Path,
Switches_TS => Empty_Time_Stamp,
Naming_Exception => No,
Duplicate_Unit => False,
Next_In_Lang => No_Source,
Next_With_File_Name => No_Source,
Roots => null);
package Source_Files_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
-- Mapping of source file names to source ids
package Source_Paths_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => Path_Name_Type,
Hash => Hash,
Equal => "=");
-- Mapping of source paths to source ids
type Lib_Kind is (Static, Static_Pic, Dynamic, Relocatable);
function Image (Kind : Lib_Kind) return String;
-- Return image of Lib_kind as used in project files
type Policy is (Restricted, Unrestricted);
-- Type to specify the symbol policy, when symbol control is supported.
-- Restricted: Restrict the symbols to those in the symbol file
-- Unrestrictedt: All symbols are exported
type Symbol_Record is record
Symbol_File : Path_Name_Type := No_Path;
Symbol_Policy : Policy := Restricted;
end record;
-- Type to keep the symbol data to be used when building a shared library
No_Symbols : constant Symbol_Record :=
(Symbol_File => No_Path,
Symbol_Policy => Restricted);
-- The default value of the symbol data
function Image (The_Casing : Casing_Type) return String;
-- Similar to 'Image (but avoid use of this attribute in compiler)
function Value (Image : String) return Casing_Type;
-- Similar to 'Value (but avoid use of this attribute in compiler)
-- Raises Constraint_Error if not a Casing_Type image.
function Hex_Image (Item : Word; Length : Positive := 8) return String;
-- Returns hexadecimal Item representation.
-- Result string would be with size Length.
-- If Length is not enough for representation, raise Constrant_Error.
procedure Hex_Image (Item : Word; Result : out String);
-- Write Item hexadecimal representation into Result. Raise
-- Constraint_Error if Result length is not enough.
-- The following record contains data for a naming scheme
function Get_Object_Directory
(Project : Project_Id;
Including_Libraries : Boolean;
Only_If_Ada : Boolean := False) return Path_Name_Type;
-- Return the object directory to use for the project. This depends on
-- whether we have a library project or a standard project. This function
-- might return No_Name when no directory applies. If the project is a
-- library project file and Including_Libraries is True then the library
-- ALI dir is returned instead of the object dir, except when there is no
-- ALI files in the Library ALI dir and the object directory exists. If
-- Only_If_Ada is True, then No_Name is returned when the project doesn't
-- include any Ada source.
procedure Compute_All_Imported_Projects
(Root_Project : Project_Id;
Tree : Project_Tree_Ref);
-- For all projects in the tree, compute the list of the projects imported
-- directly or indirectly by project Root_Project. The result is stored in
-- Project.All_Imported_Projects for each project
function Ultimate_Extending_Project_Of
(Proj : Project_Id) return Project_Id;
-- Returns the ultimate extending project of project Proj. If project Proj
-- is not extended, returns Proj.
type Project_List_Element;
type Project_List is access all Project_List_Element;
type Project_List_Element is record
Project : Project_Id := No_Project;
From_Encapsulated_Lib : Boolean := False;
Next : Project_List := null;
end record;
-- A list of projects
procedure Free_List
(List : in out Project_List;
Free_Project : Boolean);
-- Free the list of projects, if Free_Project, each project is also freed
type Export_File_Format is
(None,
Flat,
GNU,
Def);
-- The format of the different exported symbol files
type Project_Configuration is record
Target : Name_Id := No_Name;
-- The target of the configuration, when specified
Run_Path_Option : Name_List_Index := No_Name_List;
-- The option to use when linking to specify the path where to look for
-- libraries.
Run_Path_Origin : Name_Id := No_Name;
-- Specify the string (such as "$ORIGIN") to indicate paths relative to
-- the directory of the executable in the run path option.
Library_Install_Name_Option : Name_Id := No_Name;
-- When this is not an empty list, this option, followed by the single
-- name of the shared library file is used when linking a shared
-- library.
Separate_Run_Path_Options : Boolean := False;
-- True if each directory needs to be specified in a separate run path
-- option.
Executable_Suffix : Name_Id := No_Name;
-- The suffix of executables, when specified in the configuration or in
-- package Builder of the main project. When this is not specified, the
-- executable suffix is the default for the platform.
-- Linking
Linker : Path_Name_Type := No_Path;
-- Path name of the linker driver. Specified in the configuration or in
-- the package Builder of the main project.
Map_File_Option : Name_Id := No_Name;
-- Option to use when invoking the linker to build a map file
Trailing_Linker_Required_Switches : Name_List_Index := No_Name_List;
-- The minimum options for the linker driver. Specified in the
-- configuration.
Linker_Executable_Option : Name_List_Index := No_Name_List;
-- The option(s) to indicate the name of the executable in the linker
-- command. Specified in the configuration. When not specified, default
-- to -o .
Linker_Lib_Dir_Option : Name_Id := No_Name;
-- The option to specify where to find a library for linking. Specified
-- in the configuration. When not specified, defaults to "-L".
Linker_Lib_Name_Option : Name_Id := No_Name;
-- The option to specify the name of a library for linking. Specified in
-- the configuration. When not specified, defaults to "-l".
Max_Command_Line_Length : Natural := 0;
-- When positive and when Resp_File_Format (see below) is not None,
-- if the command line for the invocation of the linker would be greater
-- than this value, a response file is used to invoke the linker.
-- Also used for compiler supporting response files.
Resp_File_Format : Response_File_Format := None;
-- The format of a response file, when linking with a response file is
-- supported.
Resp_File_Options : Name_List_Index := No_Name_List;
-- The switches, if any, that precede the path name of the response
-- file in the invocation of the linker.
-- Libraries
Library_Builder : Path_Name_Type := No_Path;
-- The executable to build library (specified in the configuration)
Lib_Support : Library_Support := None;
-- The level of library support. Specified in the configuration. Support
-- is none, static libraries only or both static and shared libraries.
Lib_Encapsulated_Supported : Boolean := False;
-- True when building fully standalone libraries supported on the target
Archive_Builder : Name_List_Index := No_Name_List;
-- The name of the executable to build archives, with the minimum
-- switches. Specified in the configuration.
Archive_Builder_Append_Option : Name_List_Index := No_Name_List;
-- The options to append object files to an archive
Archive_Indexer : Name_List_Index := No_Name_List;
-- The name of the executable to index archives, with the minimum
-- switches. Specified in the configuration.
Archive_Suffix : File_Name_Type := No_File;
-- The suffix of archives. Specified in the configuration. When not
-- specified, defaults to ".a".
Object_Lister : Name_List_Index := No_Name_List;
-- The object lister if any defined
Object_Lister_Matcher : Name_Id := No_Name;
-- Pattern to match symbols out of the object lister output
Export_File_Format : GPR.Export_File_Format := GPR.None;
-- The format of the expor file
Export_File_Switch : Name_Id := No_Name;
-- Swicth to pass the export file to the linker
Lib_Partial_Linker : Name_List_Index := No_Name_List;
-- Shared libraries
Shared_Lib_Driver : File_Name_Type := No_File;
-- The driver to link shared libraries. Set with attribute Library_GCC.
-- Default to gcc.
Shared_Lib_Prefix : File_Name_Type := No_File;
-- Part of a shared library file name that precedes the name of the
-- library. Specified in the configuration. When not specified, defaults
-- to "lib".
Shared_Lib_Suffix : File_Name_Type := No_File;
-- Suffix of shared libraries, after the library name in the shared
-- library name. Specified in the configuration. When not specified,
-- default to ".so".
Shared_Lib_Min_Options : Name_List_Index := No_Name_List;
-- The minimum options to use when building a shared library
Lib_Version_Options : Name_List_Index := No_Name_List;
-- The options to use to specify a library version
Symbolic_Link_Supported : Boolean := False;
-- True if the platform supports symbolic link files
Lib_Maj_Min_Id_Supported : Boolean := False;
-- True if platform supports library major and minor options, such as
-- libname.so -> libname.so.2 -> libname.so.2.4
Auto_Init_Supported : Boolean := False;
-- True if automatic initialisation is supported for shared stand-alone
-- libraries.
-- Cleaning
Artifacts_In_Exec_Dir : Name_List_Index := No_Name_List;
-- List of regexp file names to be cleaned in the exec directory of the
-- main project.
Artifacts_In_Object_Dir : Name_List_Index := No_Name_List;
-- List of regexp file names to be cleaned in the object directory of
-- all projects.
end record;
Default_Project_Config : constant Project_Configuration :=
(Target => No_Name,
Run_Path_Option => No_Name_List,
Run_Path_Origin => No_Name,
Library_Install_Name_Option => No_Name,
Separate_Run_Path_Options => False,
Executable_Suffix => No_Name,
Linker => No_Path,
Map_File_Option => No_Name,
Trailing_Linker_Required_Switches =>
No_Name_List,
Linker_Executable_Option => No_Name_List,
Linker_Lib_Dir_Option => No_Name,
Linker_Lib_Name_Option => No_Name,
Library_Builder => No_Path,
Max_Command_Line_Length => 0,
Resp_File_Format => None,
Resp_File_Options => No_Name_List,
Lib_Support => None,
Lib_Encapsulated_Supported => False,
Archive_Builder => No_Name_List,
Archive_Builder_Append_Option => No_Name_List,
Archive_Indexer => No_Name_List,
Archive_Suffix => No_File,
Object_Lister => No_Name_List,
Object_Lister_Matcher => No_Name,
Export_File_Format => GPR.None,
Export_File_Switch => No_Name,
Lib_Partial_Linker => No_Name_List,
Shared_Lib_Driver => No_File,
Shared_Lib_Prefix => No_File,
Shared_Lib_Suffix => No_File,
Shared_Lib_Min_Options => No_Name_List,
Lib_Version_Options => No_Name_List,
Symbolic_Link_Supported => False,
Lib_Maj_Min_Id_Supported => False,
Auto_Init_Supported => False,
Artifacts_In_Exec_Dir => No_Name_List,
Artifacts_In_Object_Dir => No_Name_List);
-------------------------
-- Aggregated projects --
-------------------------
type Project_Node_Kind is
(N_Project,
N_With_Clause,
N_Project_Declaration,
N_Declarative_Item,
N_Package_Declaration,
N_String_Type_Declaration,
N_Literal_String,
N_Attribute_Declaration,
N_Typed_Variable_Declaration,
N_Variable_Declaration,
N_Expression,
N_Term,
N_Literal_String_List,
N_Variable_Reference,
N_External_Value,
N_Attribute_Reference,
N_Split,
N_Case_Construction,
N_Case_Item,
N_Comment_Zones,
N_Comment);
-- Each node in the tree is of a Project_Node_Kind. For the signification
-- of the fields in each node of Project_Node_Kind, look at package
-- Tree_Private_Part.
subtype Variable_Node_Id is Project_Node_Id;
-- Used to designate a node whose expected kind is one of
-- N_Typed_Variable_Declaration, N_Variable_Declaration or
-- N_Variable_Reference.
subtype Package_Declaration_Id is Project_Node_Id;
-- Used to designate a node whose expected kind is N_Project_Declaration
Packages_Initial : constant := 10;
Packages_Increment : constant := 100;
Package_Node_Low_Bound : constant := 0;
Package_Node_High_Bound : constant := 099_999_999;
type Pkg_Node_Id is
range Package_Node_Low_Bound .. Package_Node_High_Bound;
-- Index type for table Package_Attributes in the body
type Package_Node_Id is record
Value : Pkg_Node_Id := Package_Node_Low_Bound;
end record;
-- Full declaration of self-initialized private type
Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
Unknown_Pkg : constant Pkg_Node_Id := Package_Node_High_Bound;
Unknown_Package : constant Package_Node_Id := (Value => Unknown_Pkg);
-------------------
-- Miscellaneous --
-------------------
procedure Add_To_Path
(Directory : String;
Append : Boolean := False;
Variable : String := "PATH");
-- Add a directory to the path environment variable (by default "PATH").
-- If the variable is not defined or if its value is the empty string, set
-- the value of the variable to Directory;
-- Otherwise update the variable with Directory either in the front or in
-- the back, depending on the value of parameter Append, using a
-- Path_Separator after or before Directory.
-------------------------------
-- Restricted Access Section --
-------------------------------
package Tree_Private_Part is
-- This is conceptually in the private part. However, for efficiency,
-- some packages are accessing it directly.
type Project_Node_Record is record
Kind : Project_Node_Kind;
Qualifier : Project_Qualifier := Unspecified;
Location : Source_Ptr := No_Location;
Directory : Path_Name_Type := No_Path;
-- Only for N_Project
Display_Name : Name_Id := No_Name;
-- Only for N_Project
Expr_Kind : Variable_Kind := Undefined;
-- See below for what Project_Node_Kind it is used
Variables : Variable_Node_Id := Empty_Project_Node;
-- First variable in a project or a package
Packages : Package_Declaration_Id := Empty_Project_Node;
-- First package declaration in a project
Pkg_Id : Package_Node_Id := Empty_Package;
-- Only used for N_Package_Declaration
--
-- The component Pkg_Id is an entry into the table Package_Attributes
-- (in Prj.Attr). It is used to indicate all the attributes of the
-- package with their characteristics.
--
-- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
-- are built once and for all through a call (from Prj.Initialize)
-- to procedure Prj.Attr.Initialize. It is never modified after that.
Name : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
Src_Index : Int := 0;
-- Index of a unit in a multi-unit source.
-- Only for some N_Attribute_Declaration and N_Literal_String.
Path_Name : Path_Name_Type := No_Path;
-- See below for what Project_Node_Kind it is used
Value : Name_Id := No_Name;
-- See below for what Project_Node_Kind it is used
Default : Attribute_Default_Value := Empty_Value;
-- Only used in N_Attribute_Reference
Field1 : Project_Node_Id := Empty_Project_Node;
-- See below the meaning for each Project_Node_Kind
Field2 : Project_Node_Id := Empty_Project_Node;
-- See below the meaning for each Project_Node_Kind
Field3 : Project_Node_Id := Empty_Project_Node;
-- See below the meaning for each Project_Node_Kind
Field4 : Project_Node_Id := Empty_Project_Node;
-- See below the meaning for each Project_Node_Kind
Flag1 : Boolean := False;
-- This flag is significant only for:
--
-- N_Attribute_Declaration and N_Attribute_Reference
-- Indicates for an associative array attribute, that the
-- index is case insensitive.
--
-- N_Comment
-- Indicates that the comment is preceded by an empty line.
--
-- N_Project
-- Indicates that there are comments in the project source that
-- cannot be kept in the tree.
--
-- N_Project_Declaration
-- Indicates that there are unkept comments in the project.
--
-- N_With_Clause
-- Indicates that this is not the last with in a with clause.
-- Set for "A", but not for "B" in with "B"; and with "A", "B";
Flag2 : Boolean := False;
-- This flag is significant only for:
--
-- N_Attribute_Declaration and N_Attribute_Reference
-- Indicates if attribute values are concatenated with the value
-- in the configuration project for the same attribute.
--
-- N_Project
-- Indicates that the project "extends all" another project.
--
-- N_Comment
-- Indicates that the comment is followed by an empty line.
--
-- N_With_Clause
-- Indicates that the originally imported project is an extending
-- all project.
Comments : Project_Node_Id := Empty_Project_Node;
-- For nodes other that N_Comment_Zones or N_Comment, designates the
-- comment zones associated with the node.
--
-- For N_Comment_Zones, designates the comment after the "end" of
-- the construct.
--
-- For N_Comment, designates the next comment, if any.
Checksum : Word := 0;
-- Checksum taken from parser
end record;
-- type Project_Node_Kind is
-- (N_Project,
-- -- Name: project name
-- -- Path_Name: project path name
-- -- Expr_Kind: Undefined
-- -- Field1: first with clause
-- -- Field2: project declaration
-- -- Field3: first string type
-- -- Field4: parent project, if any
-- -- Value: extended project path name (if any)
-- N_With_Clause,
-- -- Name: imported project name
-- -- Path_Name: imported project path name
-- -- Expr_Kind: Undefined
-- -- Field1: project node
-- -- Field2: next with clause
-- -- Field3: project node or empty if "limited with"
-- -- Field4: not used
-- -- Value: literal string withed
-- N_Project_Declaration,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: Undefined
-- -- Field1: first declarative item
-- -- Field2: extended project
-- -- Field3: extending project
-- -- Field4: not used
-- -- Value: not used
-- N_Declarative_Item,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: Undefined
-- -- Field1: current item node
-- -- Field2: next declarative item
-- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used
-- N_Package_Declaration,
-- -- Name: package name
-- -- Path_Name: not used
-- -- Expr_Kind: Undefined
-- -- Field1: project of renamed package (if any)
-- -- Field2: first declarative item
-- -- Field3: next package in project
-- -- Field4: not used
-- -- Value: not used
-- N_String_Type_Declaration,
-- -- Name: type name
-- -- Path_Name: not used
-- -- Expr_Kind: Undefined
-- -- Field1: first literal string
-- -- Field2: next string type
-- -- Field3: project node
-- -- Field4: not used
-- -- Value: not used
-- N_Literal_String,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: Single
-- -- Field1: next literal string
-- -- Field2: not used
-- -- Field3: not used
-- -- Field4: not used
-- -- Value: string value
-- N_Attribute_Declaration,
-- -- Name: attribute name
-- -- Path_Name: not used
-- -- Expr_Kind: attribute kind
-- -- Field1: expression
-- -- Field2: project of full associative array
-- -- Field3: package of full associative array
-- -- Field4: not used
-- -- Value: associative array index
-- -- (if an associative array element)
-- N_Typed_Variable_Declaration,
-- -- Name: variable name
-- -- Path_Name: not used
-- -- Expr_Kind: Single
-- -- Field1: expression
-- -- Field2: type of variable (N_String_Type_Declaration)
-- -- Field3: next variable
-- -- Field4: project node
-- -- Value: not used
-- N_Variable_Declaration,
-- -- Name: variable name
-- -- Path_Name: not used
-- -- Expr_Kind: variable kind
-- -- Field1: expression
-- -- Field2: not used
-- -- Field3 is used for next variable, instead of Field2,
-- -- so that it is the same field for
-- -- N_Variable_Declaration and
-- -- N_Typed_Variable_Declaration
-- -- Field3: next variable
-- -- Field4: not used
-- -- Value: not used
-- N_Expression,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: expression kind
-- -- Field1: first term
-- -- Field2: next expression in list
-- -- Field3: not used
-- -- Value: not used
-- N_Term,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: term kind
-- -- Field1: current term
-- -- Field2: next term in the expression
-- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used
-- N_Literal_String_List,
-- -- Designates a list of string expressions between brackets
-- -- separated by commas. The string expressions are not necessarily
-- -- literal strings.
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: List
-- -- Field1: first expression
-- -- Field2: not used
-- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used
-- N_Variable_Reference,
-- -- Name: variable name
-- -- Path_Name: not used
-- -- Expr_Kind: variable kind
-- -- Field1: project (if specified)
-- -- Field2: package (if specified)
-- -- Field3: type of variable (N_String_Type_Declaration), if any
-- -- Field4: not used
-- -- Value: not used
-- N_External_Value,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: Single
-- -- Field1: Name of the external reference (literal string)
-- -- Field2: Default (literal string)
-- -- Field3: not used
-- -- Value: not used
-- N_Split,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: List
-- -- Field1: expression to split (single string)
-- -- Field2: expression of separator (single string)
-- -- Field3: not used
-- -- Value: not used
-- N_Attribute_Reference,
-- -- Name: attribute name
-- -- Path_Name: not used
-- -- Expr_Kind: attribute kind
-- -- Field1: project
-- -- Field2: package (if attribute of a package)
-- -- Field3: not used
-- -- Field4: not used
-- -- Value: associative array index
-- -- (if an associative array element)
-- N_Case_Construction,
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: Undefined
-- -- Field1: case variable reference
-- -- Field2: first case item
-- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used
-- N_Case_Item
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: not used
-- -- Field1: first choice (literal string), or Empty_Node
-- -- for when others
-- -- Field2: first declarative item
-- -- Field3: next case item
-- -- Field4: not used
-- -- Value: not used
-- N_Comment_zones
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: not used
-- -- Field1: comment before the construct
-- -- Field2: comment after the construct
-- -- Field3: comment before the "end" of the construct
-- -- Value: end of line comment
-- -- Field4: not used
-- -- Comments: comment after the "end" of the construct
-- N_Comment
-- -- Name: not used
-- -- Path_Name: not used
-- -- Expr_Kind: not used
-- -- Field1: not used
-- -- Field2: not used
-- -- Field3: not used
-- -- Field4: not used
-- -- Value: comment
-- -- Flag1: comment is preceded by an empty line
-- -- Flag2: comment is followed by an empty line
-- -- Comments: next comment
package Project_Node_Table is new
GNAT.Dynamic_Tables
(Table_Component_Type => Project_Node_Record,
Table_Index_Type => Project_Node_Id,
Table_Low_Bound => First_Project_Node_Id,
Table_Initial => Project_Nodes_Initial,
Table_Increment => Project_Nodes_Increment);
-- Table contains the syntactic tree of project data from project files
type Project_Name_And_Node is record
Name : Name_Id;
-- Name of the project
Node : Project_Node_Id;
-- Node of the project in table Project_Nodes
Resolved_Path : Path_Name_Type;
-- Resolved and canonical path of a real project file.
-- No_Name in case of virtual projects.
Extended : Boolean;
-- True when the project is being extended by another project
From_Extended : Boolean;
-- True when the project is only imported by projects that are
-- extended.
Proj_Qualifier : Project_Qualifier;
-- The project qualifier of the project, if any
end record;
No_Project_Name_And_Node : constant Project_Name_And_Node :=
(Name => No_Name,
Node => Empty_Project_Node,
Resolved_Path => No_Path,
Extended => True,
From_Extended => False,
Proj_Qualifier => Unspecified);
package Projects_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Project_Name_And_Node,
No_Element => No_Project_Name_And_Node,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- This hash table contains a mapping of project names to project nodes.
-- Note that this hash table contains only the nodes whose Kind is
-- N_Project. It is used to find the node of a project from its name,
-- and to verify if a project has already been parsed, knowing its name.
end Tree_Private_Part;
type Project_Node_Tree_Data is record
Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
Incomplete_With : Boolean := False;
-- Set to True if the projects were loaded with the flag
-- Ignore_Missing_With set to True, and there were indeed some with
-- statements that could not be resolved
end record;
type Project_Node_Tree_Ref is access all Project_Node_Tree_Data;
-- Type to designate a project node tree, so that several project node
-- trees can coexist in memory.
procedure Free (Proj : in out Project_Node_Tree_Ref);
-- Free memory used by Prj
type Aggregated_Project;
type Aggregated_Project_List is access all Aggregated_Project;
type Aggregated_Project is record
Path : Path_Name_Type;
Tree : Project_Tree_Ref;
Node_Tree : Project_Node_Tree_Ref;
Project : Project_Id;
Next : Aggregated_Project_List;
end record;
procedure Free (List : in out Aggregated_Project_List);
-- Free the memory used for List
procedure Add_Aggregated_Project
(Project : Project_Id;
Path : Path_Name_Type);
-- Add a new aggregated project in Project.
-- The aggregated project has not been processed yet. This procedure should
-- the called while processing the aggregate project, and as a result
-- Prj.Proc.Process will then automatically process the aggregated projects
------------------
-- Project_Data --
------------------
-- The following record describes a project file representation
pragma Warnings (Off);
type Standalone is
(No,
-- The following clash with Standard is OK, and justified by the context
-- which really wants to use the same set of qualifiers.
Standard,
Encapsulated);
pragma Warnings (On);
type Project_Data (Qualifier : Project_Qualifier := Unspecified) is record
-------------
-- General --
-------------
Name : Name_Id := No_Name;
-- The name of the project
Display_Name : Name_Id := No_Name;
-- The name of the project with the spelling of its declaration
Externally_Built : Boolean := False;
-- True if the project is externally built. In such case, the Project
-- Manager will not modify anything in this project.
Config : Project_Configuration;
Warning_Message : Name_Id := No_Name;
-- Message to be displayed when a project is part of the project tree
Path : Path_Information := No_Path_Information;
-- The path name of the project file. This include base name of the
-- project file.
Virtual : Boolean := False;
-- True for virtual extending projects
Location : Source_Ptr := No_Location;
-- The location in the project file source of the project name that
-- immediately follows the reserved word "project".
---------------
-- Languages --
---------------
Languages : Language_Ptr := No_Language_Index;
-- First index of the language data in the project. Traversing the list
-- gives access to all the languages supported by the project.
--------------
-- Projects --
--------------
Mains : String_List_Id := Nil_String;
-- List of mains specified by attribute Main
Extends : Project_Id := No_Project;
-- The reference of the project file, if any, that this project file
-- extends.
Extended_By : Project_Id := No_Project;
-- The reference of the project file, if any, that extends this project
-- file.
Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages) of this project
-- file.
Imported_Projects : Project_List := null;
-- The list of all directly imported projects, if any
All_Imported_Projects : Project_List := null;
-- The list of all projects imported directly or indirectly, if any.
-- This does not include the project itself.
-----------------
-- Directories --
-----------------
Directory : Path_Information := No_Path_Information;
-- Path name of the directory where the project file resides
Object_Directory : Path_Information := No_Path_Information;
-- The path name of the object directory of this project file
Exec_Directory : Path_Information := No_Path_Information;
-- The path name of the exec directory of this project file. Default is
-- equal to Object_Directory.
Object_Path_File : Path_Name_Type := No_Path;
-- Store the name of the temporary file that contains the list of object
-- directories, when attribute Object_Path_Switches is declared.
-------------
-- Library --
-------------
Library : Boolean := False;
-- True if this is a library project
Library_Name : Name_Id := No_Name;
-- If a library project, name of the library
Library_Kind : Lib_Kind := Static;
-- If a library project, kind of library
Library_Dir : Path_Information := No_Path_Information;
-- If a library project, path name of the directory where the library
-- resides.
Library_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- The timestamp of a library file in a library project
Was_Built : Boolean := False;
-- The library project has been built in the current gprbuild execution
Need_Build : Boolean := False;
-- Library project has to be built even if no need any compilation
Library_Src_Dir : Path_Information := No_Path_Information;
-- If a Stand-Alone Library project, path name of the directory where
-- the sources of the interfaces of the library are copied. By default,
-- if attribute Library_Src_Dir is not specified, sources of the
-- interfaces are not copied anywhere.
Library_ALI_Dir : Path_Information := No_Path_Information;
-- In a library project, path name of the directory where the ALI files
-- are copied. If attribute Library_ALI_Dir is not specified, ALI files
-- are copied in the Library_Dir.
Lib_Internal_Name : Name_Id := No_Name;
-- If a library project, internal name store inside the library
Standalone_Library : Standalone := No;
-- Indicate that this is a Standalone Library Project File
Lib_Interface_ALIs : String_List_Id := Nil_String;
-- For Standalone Library Project Files, list of Interface ALI files
Other_Interfaces : String_List_Id := Nil_String;
-- List of non unit based sources in attribute Interfaces
Lib_Auto_Init : Boolean := False;
-- For non static Stand-Alone Library Project Files, True if the library
-- initialisation should be automatic.
Symbol_Data : Symbol_Record := No_Symbols;
-- Symbol file name, reference symbol file name, symbol policy
-------------
-- Sources --
-------------
-- The sources for all languages including Ada are accessible through
-- the Source_Iterator type
Interfaces_Defined : Boolean := False;
-- True if attribute Interfaces is declared for the project or any
-- project it extends.
Include_Path_File : Path_Name_Type := No_Path;
-- The path name of the of the source search directory file.
-- This is only used by gnatmake
Source_Dirs : String_List_Id := Nil_String;
-- The list of all the source directories
Source_Dir_Ranks : Number_List_Index := No_Number_List;
Ada_Include_Path : String_Access := null;
-- The cached value of source search path for this project file. Set by
-- the first call to Prj.Env.Ada_Include_Path for the project. Do not
-- use this field directly outside of the project manager, use
-- Prj.Env.Ada_Include_Path instead.
Has_Multi_Unit_Sources : Boolean := False;
-- Whether there is at least one source file containing multiple units
-------------------
-- Miscellaneous --
-------------------
Ada_Objects_Path : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file, with
-- library ALI directories for library projects instead of object
-- directories. Do not use this field directly outside of the
-- compiler, use Prj.Env.Ada_Objects_Path instead.
Ada_Objects_Path_No_Libs : String_Access := null;
-- The cached value of ADA_OBJECTS_PATH for this project file with all
-- object directories (no library ALI dir for library projects).
Libgnarl_Needed : Yes_No_Unknown := Unknown;
-- Set to True when libgnarl is needed to link
Objects_Path : String_Access := null;
-- The cached value of the object dir path, used during the binding
-- phase of gprbuild.
Objects_Path_File_With_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (including library
-- dirs) for this project file.
Objects_Path_File_Without_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (excluding library
-- dirs) for this project file.
Config_File_Name : Path_Name_Type := No_Path;
-- The path name of the configuration pragmas file, if any
Config_File_Temp : Boolean := False;
-- True if the configuration pragmas file is a temporary file that must
-- be deleted at the end.
Config_Checked : Boolean := False;
-- A flag to avoid checking repetitively the configuration pragmas file
Depth : Natural := 0;
-- The maximum depth of a project in the project graph. Depth of main
-- project is 0.
Unkept_Comments : Boolean := False;
-- True if there are comments in the project sources that cannot be kept
-- in the project tree.
Checksum : Word := 0;
-- Checksum of the project taken from parser
-----------------------------
-- Qualifier-Specific data --
-----------------------------
-- The following fields are only valid for specific types of projects
case Qualifier is
when Aggregate | Aggregate_Library =>
Aggregated_Projects : Aggregated_Project_List := null;
-- List of aggregated projects (which could themselves be
-- aggregate projects).
when others =>
null;
end case;
end record;
function Empty_Project (Qualifier : Project_Qualifier) return Project_Data;
-- Return the representation of an empty project
function Is_Extending
(Extending : Project_Id;
Extended : Project_Id) return Boolean;
-- Return True if Extending is extending the Extended project
function Is_Ext
(Extending : Project_Id;
Extended : Project_Id) return Boolean renames Is_Extending;
function Has_Ada_Sources (Data : Project_Id) return Boolean;
-- Return True if the project has Ada sources
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr
package Units_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Index,
No_Element => No_Unit_Index,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of unit names to indexes in the Units table
---------------------
-- Source_Iterator --
---------------------
type Source_Iterator is private;
function For_Each_Source
(In_Tree : Project_Tree_Ref;
Project : Project_Id := No_Project;
Language : Name_Id := No_Name;
Encapsulated_Libs : Boolean := True;
Locally_Removed : Boolean := True) return Source_Iterator;
-- Returns an iterator for all the sources of a project tree, or a specific
-- project, or a specific language. Include sources from encapsulated
-- stand-alone libs if Encapsulated_Libs is True. If Locally_Removed is set
-- to False the Locally_Removed files won't be reported.
function Element (Iter : Source_Iterator) return Source_Id;
-- Return the current source (or No_Source if there are no more sources)
procedure Next (Iter : in out Source_Iterator);
-- Move on to the next source
function Find_Source
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
In_Imported_Only : Boolean := False;
In_Extended_Only : Boolean := False;
Base_Name : File_Name_Type;
Index : Int := 0) return Source_Id;
-- Find the first source file with the given name.
-- If In_Extended_Only is True, it will search in project and the project
-- it extends, but not in the imported projects.
-- Elsif In_Imported_Only is True, it will search in project and the
-- projects it imports, but not in the others or in aggregated projects.
-- Else it searches in the whole tree.
-- If Index is specified, this only search for a source with that index.
type Source_Ids is array (Positive range <>) of Source_Id;
No_Sources : constant Source_Ids := (1 .. 0 => No_Source);
function Find_All_Sources
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
In_Imported_Only : Boolean := False;
In_Extended_Only : Boolean := False;
Base_Name : File_Name_Type;
Index : Int := 0) return Source_Ids;
-- Find all source files with the given name:
--
-- If In_Extended_Only is True, it will search in project and the project
-- it extends, but not in the imported projects.
--
-- If Extended_Only is False, and In_Imported_Only is True, it will
-- search in project and the projects it imports, but not in the others
-- or in aggregated projects.
--
-- If both Extended_Only and In_Imported_Only are False (the default)
-- then it searches the whole tree.
--
-- If Index is specified, this only search for sources with that index.
-----------------------
-- Project_Tree_Data --
-----------------------
package Replaced_Source_HTable is new Simple_HTable
(Header_Num => Header_Num,
Element => File_Name_Type,
No_Element => No_File,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager
type Shared_Project_Tree_Data is record
Name_Lists : Name_List_Table.Instance;
Number_Lists : Number_List_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Private_Part : Private_Project_Tree_Data;
Dot_String_List : String_List_Id := Nil_String;
Ada_Runtime_Dir : Name_Id := No_Name;
Ada_Runtime_Source_Dirs : Name_List_Index := No_Name_List;
Ada_Runtime_Library_Dirs : Name_List_Index := No_Name_List;
Ada_Runtime_Library_Version : Name_Id := No_Name;
end record;
type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data;
-- The data that is shared among multiple trees, when these trees are
-- loaded through the same aggregate project.
-- To avoid ambiguities, limit the number of parameters to the
-- subprograms (we would have to parse the "root project tree" since this
-- is where the configuration file was loaded, in addition to the project's
-- own tree) and make the comparison of projects easier, all trees store
-- the lists in the same tables.
type Project_Tree_Appdata is tagged null record;
type Project_Tree_Appdata_Access is access all Project_Tree_Appdata'Class;
-- Application-specific data that can be associated with a project tree.
-- We do not make the Project_Tree_Data itself tagged for several reasons:
-- - it couldn't have a default value for its discriminant
-- - it would require a "factory" to allocate such data, because trees
-- are created automatically when parsing aggregate projects.
procedure Free (Tree : in out Project_Tree_Appdata);
-- Should be overridden if your derive your own data
type Project_Tree_Data (Is_Root_Tree : Boolean := True) is record
-- The root tree is the one loaded by the user from the command line.
-- Is_Root_Tree is only false for projects aggregated within a root
-- aggregate project.
Projects : Project_List;
-- List of projects in this tree
Replaced_Sources : Replaced_Source_HTable.Instance;
-- The list of sources that have been replaced by sources with
-- different file names.
Replaced_Source_Number : Natural := 0;
-- The number of entries in Replaced_Sources
Units_HT : Units_Htable.Instance;
-- Unit name to Unit_Index (and from there to Source_Id)
Source_Files_HT : Source_Files_Htable.Instance;
-- Base source file names to Source_Id list
Source_Paths_HT : Source_Paths_Htable.Instance;
-- Full path to Source_Id
-- ??? What is behavior for multi-unit source files, where there are
-- several source_id per file ?
Source_Info_File_Name : String_Access := null;
-- The name of the source info file, if specified by the builder
Source_Info_File_Exists : Boolean := False;
-- True when a source info file has been successfully read
Shared : Shared_Project_Tree_Data_Access;
-- The shared data for this tree and all aggregated trees
Appdata : Project_Tree_Appdata_Access;
-- Application-specific data for this tree
case Is_Root_Tree is
when True =>
Shared_Data : aliased Shared_Project_Tree_Data;
-- Do not access directly, only through Shared
when False =>
null;
end case;
end record;
-- Data for a project tree
function Debug_Name (Tree : Project_Tree_Ref) return Name_Id;
-- If debug traces are activated, return an identitier for the project
-- tree. This modifies Name_Buffer.
procedure Initialize (Tree : Project_Tree_Ref);
-- This procedure must be called before using any services from the Prj
-- hierarchy. Namet.Initialize must be called before Prj.Initialize.
procedure Reset (Tree : Project_Tree_Ref);
-- This procedure resets all the tables that are used when processing a
-- project file tree. Initialize must be called before the call to Reset.
package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Project_Id,
Hash => Hash,
Equal => "=");
-- A table that associates a project to a boolean. This is used to detect
-- whether a project was already processed for instance.
generic
with procedure Action (Project : Project_Id; Tree : Project_Tree_Ref);
procedure For_Project_And_Aggregated
(Root_Project : Project_Id;
Root_Tree : Project_Tree_Ref);
-- Execute Action for Root_Project and all its aggregated projects
-- recursively.
generic
type State is limited private;
with procedure Action
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State);
procedure For_Every_Project_Imported
(By : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False);
-- Call Action for each project imported directly or indirectly by project
-- By, as well as extended projects.
--
-- The order of processing depends on Imported_First:
--
-- If False, Action is called according to the order of importation: if A
-- imports B, directly or indirectly, Action will be called for A before
-- it is called for B. If two projects import each other directly or
-- indirectly (using at least one "limited with"), it is not specified
-- for which of these two projects Action will be called first.
--
-- The order is reversed if Imported_First is True
--
-- With_State may be used by Action to choose a behavior or to report some
-- global result.
--
-- If Include_Aggregated is True, then an aggregate project will recurse
-- into the projects it aggregates. Otherwise, the latter are never
-- returned.
--
-- In_Aggregate_Lib is True if the project is in an aggregate library
--
-- The Tree argument passed to the callback is required in the case of
-- aggregated projects, since they might not be using the same tree as 'By'
type Project_Context is record
In_Aggregate_Lib : Boolean;
-- True if the project is part of an aggregate library
From_Encapsulated_Lib : Boolean;
-- True if the project is imported from an encapsulated library
end record;
generic
type State is limited private;
with procedure Action
(Project : Project_Id;
Tree : Project_Tree_Ref;
Context : Project_Context;
With_State : in out State);
procedure For_Every_Project_Imported_Context
(By : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False);
-- As for For_Every_Project_Imported but with an associated context
generic
with procedure Action
(Project : Project_Id;
Tree : Project_Tree_Ref;
Context : Project_Context);
procedure For_Project_And_Aggregated_Context
(Root_Project : Project_Id;
Root_Tree : Project_Tree_Ref);
-- As for For_Project_And_Aggregated but with an associated context
function Extend_Name
(File : File_Name_Type;
With_Suffix : String) return File_Name_Type;
-- Replace the extension of File with With_Suffix
function Object_Name
(Source_File_Name : File_Name_Type;
Object_File_Suffix : Name_Id := No_Name) return File_Name_Type;
-- Returns the object file name corresponding to a source file name
function Object_Name
(Source_File_Name : File_Name_Type;
Source_Index : Int;
Index_Separator : Character;
Object_File_Suffix : Name_Id := No_Name) return File_Name_Type;
-- Returns the object file name corresponding to a unit in a multi-source
-- file.
function Dependency_Name
(Source_File_Name : File_Name_Type;
Dependency : Dependency_File_Kind) return File_Name_Type;
-- Returns the dependency file name corresponding to a source file name
function Switches_Name
(Source_File_Name : File_Name_Type) return File_Name_Type;
-- Returns the switches file name corresponding to a source file name
procedure Set_Path_File_Var (Name : String; Value : String);
-- Call Setenv, after calling To_Host_File_Spec
function Current_Source_Path_File_Of
(Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type;
-- Get the current include path file name
procedure Set_Current_Source_Path_File_Of
(Shared : Shared_Project_Tree_Data_Access;
To : Path_Name_Type);
-- Record the current include path file name
function Current_Object_Path_File_Of
(Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type;
-- Get the current object path file name
procedure Set_Current_Object_Path_File_Of
(Shared : Shared_Project_Tree_Data_Access;
To : Path_Name_Type);
-- Record the current object path file name
-----------
-- Flags --
-----------
type Processing_Flags is private;
-- Flags used while parsing and processing a project tree to configure the
-- behavior of the parser, and indicate how to report error messages. This
-- structure does not allocate memory and never needs to be freed
type Error_Warning is (Silent, Warning, Error, Decide_Later);
-- Severity of some situations, such as: no Ada sources in a project where
-- Ada is one of the language.
--
-- When the situation occurs, the behaviour depends on the setting:
--
-- - Silent: no action
-- - Warning: issue a warning, does not cause the tool to fail
-- - Error: issue an error, causes the tool to fail
-- - Decide_Later: keep the message until call to Messages_Decision
subtype Decided_Message is Error_Warning range Error_Warning'First .. Error;
type Error_Handler is access procedure
(Project : Project_Id;
Is_Warning : Boolean);
-- This warns when an error was found when parsing a project. The error
-- itself is handled through Prj.Err (and Prj.Err.Finalize should be called
-- to actually print the error). This ensures that duplicate error messages
-- are always correctly removed, that errors msgs are sorted, and that all
-- tools will report the same error to the user.
function Create_Flags
(Report_Error : Error_Handler;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True;
Require_Obj_Dirs : Error_Warning := Error;
Allow_Invalid_External : Error_Warning := Error;
Missing_Project_Files : Error_Warning := Error;
Missing_Source_Files : Error_Warning := Error;
Ignore_Missing_With : Boolean := False;
Check_Configuration_Only : Boolean := False)
return Processing_Flags;
-- Function used to create Processing_Flags structure
--
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages).
--
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source
-- files.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project). When this parameter is set to False, we do not check
-- that a proper naming scheme is defined for languages other than Ada.
--
-- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
-- If Error_On_Unknown_Language is true, an error is displayed if some of
-- the source files listed in the project do not match any naming scheme
--
-- If Require_Obj_Dirs is true, then all object directories must exist
-- (possibly after they have been created automatically if the appropriate
-- switches were specified), or an error is raised.
--
-- If Allow_Invalid_External is Silent, then no error is reported when an
-- invalid value is used for an external variable (and it doesn't match its
-- type). Instead, the first possible value is used.
--
-- Missing_Source_Files indicates whether it is an error or a warning that
-- a source file mentioned in the Source_Files attributes is not actually
-- found in the source directories. This also impacts errors for missing
-- source directories.
--
-- If Ignore_Missing_With is True, then a "with" statement that cannot be
-- resolved will simply be ignored. However, in such a case, the flag
-- Incomplete_With in the project tree will be set to True.
-- This is meant for use by tools so that they can properly set the
-- project path in such a case:
-- * no "gnatls" found (so no default project path)
-- * user project sets Project.IDE'gnatls attribute to a cross gnatls
-- * user project also includes a "with" that can only be resolved
-- once we have found the gnatls
procedure Set_Ignore_Missing_With
(Flags : in out Processing_Flags;
Value : Boolean);
-- Set the value of component Ignore_Missing_With in Flags to Value
procedure Set_Require_Obj_Dirs
(Flags : in out Processing_Flags;
Value : Error_Warning);
-- Set the value of component Require_Object_Dirs in Flags to Value
procedure Set_Check_Configuration_Only
(Flags : in out Processing_Flags;
Value : Boolean);
-- Set the value of component Check_Configuration_Only in Flags to Value
procedure Set_Missing_Source_Files
(Flags : in out Processing_Flags;
Value : Error_Warning);
-- Set the value of component Missing_Source_Files in Flags to Value
Gprbuild_Flags : constant Processing_Flags;
Gprinstall_Flags : constant Processing_Flags;
Gprclean_Flags : constant Processing_Flags;
Gprname_Flags : constant Processing_Flags;
Gprls_Flags : constant Processing_Flags;
-- Flags used by the various tools. They all display the error messages
-- through Prj.Err.
----------------
-- Temp Files --
----------------
procedure Record_Temp_File
(Shared : Shared_Project_Tree_Data_Access;
Path : Path_Name_Type);
-- Record the path of a newly created temporary file, so that it can be
-- deleted later.
procedure Delete_All_Temp_Files
(Shared : Shared_Project_Tree_Data_Access);
-- Delete all recorded temporary files.
-- Does nothing if Debug.Debug_Flag_N is set
procedure Delete_Temporary_File
(Shared : Shared_Project_Tree_Data_Access := null;
Path : Path_Name_Type);
procedure Delete_Temporary_File
(Shared : Shared_Project_Tree_Data_Access := null;
Path : String);
-- Delete a temporary file from the disk. The file is also removed from the
-- list of temporary files to delete at the end of the program, in case
-- another program running on the same machine has recreated it. Does
-- nothing if Debug.Debug_Flag_N is set
Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is
-- normally forbidden for project names, there cannot be any name clash.
-----------
-- Debug --
-----------
type Verbosity is (Default, Medium, High);
pragma Ordered (Verbosity);
-- Verbosity when parsing GNAT Project Files
-- Default is default (very quiet, if no errors).
-- Medium is more verbose.
-- High is extremely verbose.
Current_Verbosity : Verbosity := Default;
-- The current value of the verbosity the project files are parsed with
procedure Debug_Indent;
-- Inserts a series of blanks depending on the current indentation level
procedure Debug_Output (Str : String);
procedure Debug_Output (Str : String; Str2 : Name_Id);
-- If Current_Verbosity is not Default, outputs Str.
-- This indents Str based on the current indentation level for traces
-- Debug_Error is intended to be used to report an error in the traces.
procedure Debug_Increase_Indent
(Str : String := ""; Str2 : Name_Id := No_Name);
procedure Debug_Decrease_Indent (Str : String := "");
-- Increase or decrease the indentation level for debug traces. This
-- indentation level only affects output done through Debug_Output.
Total_Errors_Detected : Nat := 0;
Warnings_Detected : Nat := 0;
Native_Target : Boolean := False;
-- True when no target is specified on the command line or in the main
-- project.
function To_Hash (Item : Name_Id) return Ada.Containers.Hash_Type;
package Name_Id_Maps is new Ada.Containers.Hashed_Maps
(Key_Type => Name_Id,
Element_Type => Name_Id,
Hash => To_Hash,
Equivalent_Keys => "=");
package Language_Maps renames Name_Id_Maps;
-- Hash table to keep the languages and its required versions used in
-- the project tree.
package Path_Name_HTable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Path_Name_Type,
Hash => Hash,
Equal => "=");
private
function To_Hash (Item : Name_Id) return Ada.Containers.Hash_Type
is (Ada.Containers.Hash_Type (Item));
Tool_Name : String_Access := null;
Serious_Errors_Detected : Nat := 0;
Warnings_Treated_As_Errors : Nat := 0;
Info_Messages : Nat := 0;
Gprls_Mode : Boolean := False;
-- When True, an ALI file may be found in an extending project, even if
-- the corresponding object file is not found in the same project.
-- This is only for gprls.
All_Packages : constant String_List_Access := null;
No_Project_Tree : constant Project_Tree_Ref := null;
Ignored : constant Variable_Kind := Single;
Nil_Variable_Value : constant Variable_Value :=
(Project => No_Project,
Kind => Undefined,
Location => No_Location,
Default => False,
String_Type => Empty_Project_Node,
From_Implicit_Target => False);
type Source_Iterator is record
In_Tree : Project_Tree_Ref;
Project : Project_List;
All_Projects : Boolean;
-- Current project and whether we should move on to the next
Language : Language_Ptr;
-- Current language processed
Language_Name : Name_Id;
-- Only sources of this language will be returned (or all if No_Name)
Current : Source_Id;
Encapsulated_Libs : Boolean;
-- True if we want to include the sources from encapsulated libs
Locally_Removed : Boolean;
end record;
procedure Add_To_Buffer
(S : String;
To : in out String_Access;
Last : in out Natural);
-- Append a String to the Buffer
-- Table used to store the path name of all the created temporary files, so
-- that they can be deleted at the end, or when the program is interrupted.
function Distance (L, R : String) return Natural;
-- Damerau Levenshtein distance between L and R strings.
-- Calculated in minimum number of elementary operations to convert one
-- string to another. The operations are deletion, insertion, substitution,
-- and transposition (swap 2 adjacent characters).
package Temp_Files_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Path_Name_Type,
Table_Index_Type => Integer,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 10);
-- The following type is used to represent the part of a project tree which
-- is private to the Project Manager.
type Private_Project_Tree_Data is record
Temp_Files : Temp_Files_Table.Instance;
-- Temporary files created as part of running tools (pragma files,
-- mapping files,...)
Current_Source_Path_File : Path_Name_Type := No_Path;
-- Current value of project source path file env var. Used to avoid
-- setting the env var to the same value. When different from No_Path,
-- this indicates that environment variables were created and should be
-- deassigned to avoid polluting the environment. For gnatmake only.
Current_Object_Path_File : Path_Name_Type := No_Path;
-- Current value of project object path file env var. Used to avoid
-- setting the env var to the same value.
-- gnatmake only
end record;
Executable_Extension_On_Target : Name_Id := No_Name;
-- The following type is used to hold processing flags which show what
-- functions are required for the various tools that are handled.
type Processing_Flags is record
Require_Sources_Other_Lang : Boolean;
Report_Error : Error_Handler;
When_No_Sources : Error_Warning;
Allow_Duplicate_Basenames : Boolean;
Compiler_Driver_Mandatory : Boolean;
Error_On_Unknown_Language : Boolean;
Require_Obj_Dirs : Error_Warning;
Allow_Invalid_External : Error_Warning;
Missing_Project_Files : Error_Warning;
Missing_Source_Files : Error_Warning;
Ignore_Missing_With : Boolean;
Check_Configuration_Only : Boolean;
Incomplete_Withs : Boolean := False;
-- This flag is set to True when the projects are parsed while ignoring
-- missing withed project and some withed projects are not found.
end record;
Gprbuild_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Project_Files => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False,
Incomplete_Withs => False,
Check_Configuration_Only => False);
Gprinstall_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Silent,
Allow_Invalid_External => Error,
Missing_Project_Files => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False,
Incomplete_Withs => False,
Check_Configuration_Only => False);
Gprclean_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Warning,
Allow_Invalid_External => Error,
Missing_Project_Files => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False,
Incomplete_Withs => False,
Check_Configuration_Only => False);
Gprname_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Project_Files => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False,
Incomplete_Withs => False,
Check_Configuration_Only => True);
Gprls_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error,
Allow_Invalid_External => Error,
Missing_Project_Files => Error,
Missing_Source_Files => Error,
Ignore_Missing_With => False,
Incomplete_Withs => False,
Check_Configuration_Only => False);
end GPR;