diff options
Diffstat (limited to 'gcc/ada/prj.ads')
| -rw-r--r-- | gcc/ada/prj.ads | 393 |
1 files changed, 273 insertions, 120 deletions
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 21c796c..a1b685e 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -35,39 +35,47 @@ with Scans; use Scans; with Table; with Types; use Types; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; +with GNAT.Dynamic_Tables; +with GNAT.OS_Lib; use GNAT.OS_Lib; -with System.HTable; use System.HTable; +with System.HTable; package Prj is - Empty_Name : Name_Id; - -- Name_Id for an empty name (no characters). Initialized by the call - -- to procedure Initialize. - - All_Packages : constant String_List_Access := null; + 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. - 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. + 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. - Project_File_Extension : String := ".gpr"; - -- The standard project file name extension. It is not a constant, because - -- Canonical_Case_File_Name is called on this variable in the body of Prj. + No_Project_Tree : constant Project_Tree_Ref; - Default_Ada_Spec_Suffix : Name_Id; + function Default_Ada_Spec_Suffix return Name_Id; + pragma Inline (Default_Ada_Spec_Suffix); -- The Name_Id for the standard GNAT suffix for Ada spec source file -- name ".ads". Initialized by Prj.Initialize. - Default_Ada_Body_Suffix : Name_Id; + function Default_Ada_Body_Suffix return Name_Id; + pragma Inline (Default_Ada_Body_Suffix); -- The Name_Id for the standard GNAT suffix for Ada body source file -- name ".adb". Initialized by Prj.Initialize. - Slash : Name_Id; + function Slash return Name_Id; + pragma Inline (Slash); -- "/", used as the path of locally removed files + Project_File_Extension : String := ".gpr"; + -- The standard project file name extension. It is not a constant, because + -- Canonical_Case_File_Name is called on this variable in the body of Prj. + + ----------------------------------------------------- + -- Multi-language stuff that will be modified soon -- + ----------------------------------------------------- + type Language_Index is new Nat; No_Language_Index : constant Language_Index := 0; @@ -129,13 +137,12 @@ package Prj is Next : Supp_Language_Index := No_Supp_Language_Index; end record; - package Present_Languages is new Table.Table + package Present_Language_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Supp_Language, Table_Index_Type => Supp_Language_Index, Table_Low_Bound => 1, Table_Initial => 4, - Table_Increment => 100, - Table_Name => "Prj.Present_Languages"); + Table_Increment => 100); -- The table for the presence of languages with an index that is outside -- of First_Language_Indexes. @@ -152,13 +159,12 @@ package Prj is Next : Supp_Language_Index := No_Supp_Language_Index; end record; - package Supp_Suffix_Table is new Table.Table + package Supp_Suffix_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Supp_Suffix, Table_Index_Type => Supp_Language_Index, Table_Low_Bound => 1, Table_Initial => 4, - Table_Increment => 100, - Table_Name => "Prj.Supp_Suffix_Table"); + Table_Increment => 100); -- The table for the presence of languages with an index that is outside -- of First_Language_Indexes. @@ -172,13 +178,12 @@ package Prj is Next : Name_List_Index := No_Name_List; end record; - package Name_Lists is new Table.Table + 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, - Table_Name => "Prj.Name_Lists"); + Table_Increment => 100); -- The table for lists of names used in package Language_Processing type Language_Processing_Data is record @@ -206,8 +211,9 @@ package Prj is type First_Language_Processing_Data is array (First_Language_Indexes) of Language_Processing_Data; - Default_First_Language_Processing_Data : First_Language_Processing_Data := - (others => Default_Language_Processing_Data); + Default_First_Language_Processing_Data : + constant First_Language_Processing_Data := + (others => Default_Language_Processing_Data); type Supp_Language_Data is record Index : Language_Index := No_Language_Index; @@ -215,13 +221,12 @@ package Prj is Next : Supp_Language_Index := No_Supp_Language_Index; end record; - package Supp_Languages is new Table.Table + package Supp_Language_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Supp_Language_Data, Table_Index_Type => Supp_Language_Index, Table_Low_Bound => 1, Table_Initial => 4, - Table_Increment => 100, - Table_Name => "Prj.Supp_Languages"); + Table_Increment => 100); -- The table for language data when there are more languages than -- in First_Language_Indexes. @@ -243,21 +248,27 @@ package Prj is end record; -- Data for a source in a language other than Ada - package Other_Sources is new Table.Table + package Other_Source_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Other_Source, Table_Index_Type => Other_Source_Id, Table_Low_Bound => 1, Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Prj.Other_Sources"); + Table_Increment => 100); -- The table for sources of languages other than Ada + ---------------------------------- + -- End of multi-language stuff -- + ---------------------------------- + type Verbosity is (Default, Medium, High); -- 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 + type Lib_Kind is (Static, Dynamic, Relocatable); type Policy is (Autonomous, Compliant, Controlled, Restricted); -- Type to specify the symbol policy, when symbol control is supported. @@ -274,7 +285,7 @@ package Prj is end record; -- Type to keep the symbol data to be used when building a shared library - No_Symbols : Symbol_Record := + No_Symbols : constant Symbol_Record := (Symbol_File => No_Name, Reference => No_Name, Symbol_Policy => Autonomous); @@ -301,13 +312,12 @@ package Prj is -- Component Flag may be used for various purposes. For source -- directories, it indicates if the directory contains Ada source(s). - package String_Elements is new Table.Table + 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, - Table_Name => "Prj.String_Elements"); + Table_Increment => 100); -- The table for string elements in string lists type Variable_Kind is (Undefined, List, Single); @@ -316,7 +326,7 @@ package Prj is subtype Defined_Variable_Kind is Variable_Kind range List .. Single; -- The defined kinds of variables - Ignored : constant Variable_Kind := Single; + Ignored : constant Variable_Kind; -- Used to indicate that a package declaration must be ignored -- while processing the project tree (unknown package name). @@ -337,11 +347,7 @@ package Prj is -- Values for variables and array elements. Default is True if the -- current value is the default one for the variable - Nil_Variable_Value : constant Variable_Value := - (Project => No_Project, - Kind => Undefined, - Location => No_Location, - Default => False); + Nil_Variable_Value : constant Variable_Value; -- Value of a non existing variable or array element type Variable_Id is new Nat; @@ -353,13 +359,12 @@ package Prj is end record; -- To hold the list of variables in a project file and in packages - package Variable_Elements is new Table.Table + 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, - Table_Name => "Prj.Variable_Elements"); + Table_Increment => 100); -- The table of variable in list of variables type Array_Element_Id is new Nat; @@ -374,13 +379,12 @@ package Prj is -- Each Array_Element represents an array element and is linked (Next) -- to the next array element, if any, in the array. - package Array_Elements is new Table.Table + 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, - Table_Name => "Prj.Array_Elements"); + Table_Increment => 100); -- The table that contains all array elements type Array_Id is new Nat; @@ -394,13 +398,12 @@ package Prj is -- Value is the id of the first element. -- Next is the id of the next array in the project file or package. - package Arrays is new Table.Table + 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, - Table_Name => "Prj.Arrays"); + Table_Increment => 100); -- The table that contains all arrays type Package_Id is new Nat; @@ -429,13 +432,12 @@ package Prj is end record; -- A package. Includes declarations that may include other packages. - package Packages is new Table.Table + 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, - Table_Name => "Prj.Packages"); + Table_Increment => 100); -- The table that contains all packages. function Image (Casing : Casing_Type) return String; @@ -511,9 +513,12 @@ package Prj is end record; - function Standard_Naming_Data return Naming_Data; + function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree) + return Naming_Data; pragma Inline (Standard_Naming_Data); - -- The standard GNAT naming scheme + -- The standard GNAT naming scheme when Tree is No_Project_Tree. + -- Otherwise, return the default naming scheme for the project tree Tree, + -- which must have been Initialized. function Same_Naming_Scheme (Left, Right : Naming_Data) return Boolean; @@ -531,13 +536,12 @@ package Prj is -- Element in a list of project files. Next is the id of the next -- project file in the list. - package Project_Lists is new Table.Table + package Project_List_Table is new GNAT.Dynamic_Tables (Table_Component_Type => Project_Element, Table_Index_Type => Project_List, Table_Low_Bound => 1, Table_Initial => 100, - Table_Increment => 100, - Table_Name => "Prj.Project_Lists"); + Table_Increment => 100); -- The table that contains the lists of project files -- The following record describes a project file representation @@ -782,80 +786,126 @@ package Prj is end record; - function Is_Present - (Language : Language_Index; - In_Project : Project_Data) return Boolean; - -- Return True when Language is one of the languages used in - -- project Project. - - procedure Set - (Language : Language_Index; - Present : Boolean; - In_Project : in out Project_Data); - -- Indicate if Language is or not a language used in project Project - - function Language_Processing_Data_Of - (Language : Language_Index; - In_Project : Project_Data) return Language_Processing_Data; - -- Return the Language_Processing_Data for language Language in project - -- In_Project. Return the default when no Language_Processing_Data are - -- defined for the language. - - procedure Set - (Language_Processing : Language_Processing_Data; - For_Language : Language_Index; - In_Project : in out Project_Data); - -- Set the Language_Processing_Data for language Language in project - -- In_Project. - - function Suffix_Of - (Language : Language_Index; - In_Project : Project_Data) return Name_Id; - -- Return the suffix for language Language in project In_Project. Return - -- No_Name when no suffix is defined for the language. - - procedure Set - (Suffix : Name_Id; - For_Language : Language_Index; - In_Project : in out Project_Data); - -- Set the suffix for language Language in project In_Project + function Empty_Project (Tree : Project_Tree_Ref) return Project_Data; + -- Return the representation of an empty project in project Tree tree. + -- The project tree Tree must have been Initialized and/or Reset. Project_Error : exception; -- Raised by some subprograms in Prj.Attr. - function Empty_Project return Project_Data; - -- Return the representation of an empty project - - package Projects is new Table.Table ( + package Project_Table is new GNAT.Dynamic_Tables ( Table_Component_Type => Project_Data, Table_Index_Type => Project_Id, Table_Low_Bound => 1, Table_Initial => 100, - Table_Increment => 100, - Table_Name => "Prj.Projects"); + Table_Increment => 100); -- The set of all project files + type Spec_Or_Body is + (Specification, Body_Part); + + type File_Name_Data is record + Name : Name_Id := No_Name; + Index : Int := 0; + Display_Name : Name_Id := No_Name; + Path : Name_Id := No_Name; + Display_Path : Name_Id := No_Name; + Project : Project_Id := No_Project; + Needs_Pragma : Boolean := False; + end record; + -- File and Path name of a spec or body. + + type File_Names_Data is array (Spec_Or_Body) of File_Name_Data; + + type Unit_Id is new Nat; + No_Unit : constant Unit_Id := 0; + type Unit_Data is record + Name : Name_Id := No_Name; + File_Names : File_Names_Data; + end record; + -- Name and File and Path names of a unit, with a reference to its + -- GNAT Project File(s). + + package Unit_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Unit_Data, + Table_Index_Type => Unit_Id, + Table_Low_Bound => 1, + Table_Initial => 100, + Table_Increment => 100); + -- Table of all units in a project tree + + package Units_Htable is new Simple_HTable + (Header_Num => Header_Num, + Element => Unit_Id, + No_Element => No_Unit, + Key => Name_Id, + Hash => Hash, + Equal => "="); + -- Mapping of unit names to indexes in the Units table + + type Unit_Project is record + Unit : Unit_Id := No_Unit; + Project : Project_Id := No_Project; + end record; + + No_Unit_Project : constant Unit_Project := (No_Unit, No_Project); + + package Files_Htable is new Simple_HTable + (Header_Num => Header_Num, + Element => Unit_Project, + No_Element => No_Unit_Project, + Key => Name_Id, + Hash => Hash, + Equal => "="); + -- Mapping of file names to indexes in the Units table + + type Private_Project_Tree_Data is private; + -- Data for a project tree that is used only by the Project Manager + + type Project_Tree_Data is + record + Present_Languages : Present_Language_Table.Instance; + Supp_Suffixes : Supp_Suffix_Table.Instance; + Name_Lists : Name_List_Table.Instance; + Supp_Languages : Supp_Language_Table.Instance; + Other_Sources : Other_Source_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; + Project_Lists : Project_List_Table.Instance; + Projects : Project_Table.Instance; + Units : Unit_Table.Instance; + Units_HT : Units_Htable.Instance; + Files_HT : Files_Htable.Instance; + Private_Part : Private_Project_Tree_Data; + end record; + -- Data for a project tree + type Put_Line_Access is access procedure (Line : String; - Project : Project_Id); + Project : Project_Id; + In_Tree : Project_Tree_Ref); -- Use to customize error reporting in Prj.Proc and Prj.Nmsc procedure Expect (The_Token : Token_Type; Token_Image : String); -- Check that the current token is The_Token. If it is not, then -- output an error message. - procedure Initialize; + 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; + 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. procedure Register_Default_Naming_Scheme (Language : Name_Id; Default_Spec_Suffix : Name_Id; - Default_Body_Suffix : Name_Id); + Default_Body_Suffix : Name_Id; + In_Tree : Project_Tree_Ref); -- Register the default suffixes for a given language. These extensions -- will be ignored if the user has specified a new naming scheme in a -- project file. @@ -870,29 +920,132 @@ package Prj is With_State : in out State); procedure For_Every_Project_Imported (By : Project_Id; + In_Tree : Project_Tree_Ref; With_State : in out State); -- Call Action for each project imported directly or indirectly by project -- By. 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. With_State may be used by Action to choose a - -- behavior or to report some global result. + -- 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. Projects + -- that are extended by other projects are not considered. With_State may + -- be used by Action to choose a behavior or to report some global result. + + ---------------------------------------------------------- + -- Other multi-language stuff that may be modified soon -- + ---------------------------------------------------------- + + function Is_Present + (Language : Language_Index; + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Boolean; + -- Return True when Language is one of the languages used in + -- project Project. + + procedure Set + (Language : Language_Index; + Present : Boolean; + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref); + -- Indicate if Language is or not a language used in project Project + + function Language_Processing_Data_Of + (Language : Language_Index; + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Language_Processing_Data; + -- Return the Language_Processing_Data for language Language in project + -- In_Project. Return the default when no Language_Processing_Data are + -- defined for the language. + + procedure Set + (Language_Processing : Language_Processing_Data; + For_Language : Language_Index; + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref); + -- Set the Language_Processing_Data for language Language in project + -- In_Project. + + function Suffix_Of + (Language : Language_Index; + In_Project : Project_Data; + In_Tree : Project_Tree_Ref) return Name_Id; + -- Return the suffix for language Language in project In_Project. Return + -- No_Name when no suffix is defined for the language. + + procedure Set + (Suffix : Name_Id; + For_Language : Language_Index; + In_Project : in out Project_Data; + In_Tree : Project_Tree_Ref); + -- Set the suffix for language Language in project In_Project private - Initial_Buffer_Size : constant := 100; - -- Initial size for extensible buffer used below + All_Packages : constant String_List_Access := null; - Buffer : String_Access := new String (1 .. Initial_Buffer_Size); - -- An extensible character buffer to store names. Used in Prj.Part and - -- Prj.Strt. + No_Project_Tree : constant Project_Tree_Ref := null; - Buffer_Last : Natural := 0; - -- The index of the last character in the Buffer + Ignored : constant Variable_Kind := Single; - Current_Packages_To_Check : String_List_Access := All_Packages; - -- Global variable, set by Prj.Part.Parse, used by Prj.Dect. + Nil_Variable_Value : constant Variable_Value := + (Project => No_Project, + Kind => Undefined, + Location => No_Location, + Default => False); - procedure Add_To_Buffer (S : String); + 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. + + Empty_Name : Name_Id; + -- Name_Id for an empty name (no characters). Initialized by the call + -- to procedure Initialize. + + procedure Add_To_Buffer + (S : String; + To : in out String_Access; + Last : in out Natural); -- Append a String to the Buffer + type Naming_Id is new Nat; + + package Naming_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Naming_Data, + Table_Index_Type => Naming_Id, + Table_Low_Bound => 1, + Table_Initial => 5, + Table_Increment => 100); + + package Path_File_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50); + -- Table storing all the temp path file names. + -- Used by Delete_All_Path_Files. + + package Source_Path_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50); + -- A table to store the source dirs before creating the source path file + + package Object_Path_Table is new GNAT.Dynamic_Tables + (Table_Component_Type => Name_Id, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 50, + Table_Increment => 50); + -- A table to store the object dirs, before creating the object path file + + type Private_Project_Tree_Data is record + Namings : Naming_Table.Instance; + Path_Files : Path_File_Table.Instance; + Source_Paths : Source_Path_Table.Instance; + Object_Paths : Object_Path_Table.Instance; + Default_Naming : Naming_Data; + end record; end Prj; |