MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
3b56934fb9
8sa1-gcc/gcc/ada/prj-tree.adb
Vincent Celier b30668b77a * make.adb: 
(Add_Switches): reflect the changes for the switches attributes
	Default_Switches indexed by the programming language,
	Switches indexed by the file name.
	(Collect_Arguments_And_Compile): Idem.
	Reflect the attribute name changes.

	* prj-attr.adb:
	(Initialisation_Data): Change the names of some packages and
	attributes.
	(Initialize): process case insensitive associative arrays.

	* prj-attr.ads:
	(Attribute_Kind): Remove Both, add Case_Insensitive_Associative_Array.

	* prj-dect.adb:
	(Parse_Attribute_Declaration): For case insensitive associative
	 arrays, set the index string to lower case.

	* prj-env.adb:
	Reflect the changes of the project attributes.

	* prj-nmsc.adb:
	Replace Check_Naming_Scheme by Ada_Check and
	Language_Independent_Check.

	* prj-nmsc.ads:
	Replaced Check_Naming_Scheme by 2 procedures:
	Ada_Check and Language_Independent_Check.

	* prj-proc.adb:
	(Process_Declarative_Items): For case-insensitive associative
	arrays, set the index string to lower case.
	(Recursive_Check): Call Prj.Nmsc.Ada_Check, instead of
	Prj.Nmsc.Check_Naming_Scheme.

	* prj-tree.adb:
	(Case_Insensitive): New function
	(Set_Case_Insensitive): New procedure

	* prj-tree.ads:
	(Case_Insensitive): New function
	(Set_Case_Insensitive): New procedure
	(Project_Node_Record): New flag Case_Insensitive.

	* prj-util.adb:
	(Value_Of): new function to get the string value of a single
	string variable or attribute.

	* prj-util.ads:
	(Value_Of): new function to get the string value of a single
	string variable or attribute.

	* prj.adb:
	(Ada_Default_Spec_Suffix): New function
	(Ada_Default_Impl_Suffix): New function
	Change definitions of several constants to reflect
	new components of record types.

	* prj.ads:
	(Naming_Data): Change several components to reflect new
	elements of naming schemes.
	(Project_Data): New flags Sources_Present and
	Language_Independent_Checked.
	(Ada_Default_Spec_Suffix): New function.
	(Ada_Default_Impl_Suffix): New function.

	* snames.ads:
	Modification of predefined names for project manager: added
	Implementation, Specification_Exceptions, Implementation_Exceptions,
	Specification_Suffix, Implementation_Suffix, Separate_Suffix,
	Default_Switches, _Languages, Builder, Cross_Reference,
	Finder. Removed Body_Part, Specification_Append, Body_Append,
	Separate_Append, Gnatmake, Gnatxref, Gnatfind, Gnatbind,
	Gnatlink.

	* prj.ads: (Ada_Default_Spec_Suffix, Ada_Default_Impl_Suffix):
	Add comments.

	* prj-nmsc.adb (Ada_Check): Test that Separate_Suffix is defaulted,
	not that it is Nil_Variable_Value.

	* prj.ads: Add ??? for uncommented declarations

From-SVN: r46169
2001-10-11 03:02:03 +02:00

1509 lines
41 KiB
Ada
Raw Blame History

------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R J . T R E E --
-- --
-- B o d y --
-- --
-- $Revision$
-- --
-- Copyright (C) 2001 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Stringt; use Stringt;
package body Prj.Tree is
use Tree_Private_Part;
--------------------------------
-- Associative_Array_Index_Of --
--------------------------------
function Associative_Array_Index_Of
(Node : Project_Node_Id)
return String_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return Project_Nodes.Table (Node).Value;
end Associative_Array_Index_Of;
----------------------
-- Case_Insensitive --
----------------------
function Case_Insensitive (Node : Project_Node_Id) return Boolean is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return Project_Nodes.Table (Node).Case_Insensitive;
end Case_Insensitive;
--------------------------------
-- Case_Variable_Reference_Of --
--------------------------------
function Case_Variable_Reference_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Construction);
return Project_Nodes.Table (Node).Field1;
end Case_Variable_Reference_Of;
-----------------------
-- Current_Item_Node --
-----------------------
function Current_Item_Node
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return Project_Nodes.Table (Node).Field1;
end Current_Item_Node;
------------------
-- Current_Term --
------------------
function Current_Term
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Term);
return Project_Nodes.Table (Node).Field1;
end Current_Term;
--------------------------
-- Default_Project_Node --
--------------------------
function Default_Project_Node
(Of_Kind : Project_Node_Kind;
And_Expr_Kind : Variable_Kind := Undefined)
return Project_Node_Id
is
begin
Project_Nodes.Increment_Last;
Project_Nodes.Table (Project_Nodes.Last) :=
(Kind => Of_Kind,
Location => No_Location,
Directory => No_Name,
Expr_Kind => And_Expr_Kind,
Variables => Empty_Node,
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Path_Name => No_Name,
Value => No_String,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Case_Insensitive => False);
return Project_Nodes.Last;
end Default_Project_Node;
------------------
-- Directory_Of --
------------------
function Directory_Of (Node : Project_Node_Id) return Name_Id is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
return Project_Nodes.Table (Node).Directory;
end Directory_Of;
------------------------
-- Expression_Kind_Of --
------------------------
function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Literal_String
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Expression
or else
Project_Nodes.Table (Node).Kind = N_Term
or else
Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
return Project_Nodes.Table (Node).Expr_Kind;
end Expression_Kind_Of;
-------------------
-- Expression_Of --
-------------------
function Expression_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
return Project_Nodes.Table (Node).Field1;
end Expression_Of;
---------------------------
-- External_Reference_Of --
---------------------------
function External_Reference_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_External_Value);
return Project_Nodes.Table (Node).Field1;
end External_Reference_Of;
-------------------------
-- External_Default_Of --
-------------------------
function External_Default_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_External_Value);
return Project_Nodes.Table (Node).Field2;
end External_Default_Of;
------------------------
-- First_Case_Item_Of --
------------------------
function First_Case_Item_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Construction);
return Project_Nodes.Table (Node).Field2;
end First_Case_Item_Of;
---------------------
-- First_Choice_Of --
---------------------
function First_Choice_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Item);
return Project_Nodes.Table (Node).Field1;
end First_Choice_Of;
-------------------------------
-- First_Declarative_Item_Of --
-------------------------------
function First_Declarative_Item_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Case_Item
or else
Project_Nodes.Table (Node).Kind = N_Package_Declaration));
if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
return Project_Nodes.Table (Node).Field1;
else
return Project_Nodes.Table (Node).Field2;
end if;
end First_Declarative_Item_Of;
------------------------------
-- First_Expression_In_List --
------------------------------
function First_Expression_In_List
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Literal_String_List);
return Project_Nodes.Table (Node).Field1;
end First_Expression_In_List;
--------------------------
-- First_Literal_String --
--------------------------
function First_Literal_String
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
return Project_Nodes.Table (Node).Field1;
end First_Literal_String;
----------------------
-- First_Package_Of --
----------------------
function First_Package_Of
(Node : Project_Node_Id)
return Package_Declaration_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
return Project_Nodes.Table (Node).Packages;
end First_Package_Of;
--------------------------
-- First_String_Type_Of --
--------------------------
function First_String_Type_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
return Project_Nodes.Table (Node).Field3;
end First_String_Type_Of;
----------------
-- First_Term --
----------------
function First_Term
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Expression);
return Project_Nodes.Table (Node).Field1;
end First_Term;
-----------------------
-- First_Variable_Of --
-----------------------
function First_Variable_Of
(Node : Project_Node_Id)
return Variable_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Project
or else
Project_Nodes.Table (Node).Kind = N_Package_Declaration));
return Project_Nodes.Table (Node).Variables;
end First_Variable_Of;
--------------------------
-- First_With_Clause_Of --
--------------------------
function First_With_Clause_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
return Project_Nodes.Table (Node).Field1;
end First_With_Clause_Of;
----------------
-- Initialize --
----------------
procedure Initialize is
begin
Project_Nodes.Set_Last (Empty_Node);
Projects_Htable.Reset;
end Initialize;
-------------
-- Kind_Of --
-------------
function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is
begin
pragma Assert (Node /= Empty_Node);
return Project_Nodes.Table (Node).Kind;
end Kind_Of;
-----------------
-- Location_Of --
-----------------
function Location_Of (Node : Project_Node_Id) return Source_Ptr is
begin
pragma Assert (Node /= Empty_Node);
return Project_Nodes.Table (Node).Location;
end Location_Of;
-------------------------
-- Modified_Project_Of --
-------------------------
function Modified_Project_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project_Declaration);
return Project_Nodes.Table (Node).Field2;
end Modified_Project_Of;
------------------------------
-- Modified_Project_Path_Of --
------------------------------
function Modified_Project_Path_Of
(Node : Project_Node_Id)
return String_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
return Project_Nodes.Table (Node).Value;
end Modified_Project_Path_Of;
-------------
-- Name_Of --
-------------
function Name_Of (Node : Project_Node_Id) return Name_Id is
begin
pragma Assert (Node /= Empty_Node);
return Project_Nodes.Table (Node).Name;
end Name_Of;
--------------------
-- Next_Case_Item --
--------------------
function Next_Case_Item
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Item);
return Project_Nodes.Table (Node).Field3;
end Next_Case_Item;
---------------------------
-- Next_Declarative_Item --
---------------------------
function Next_Declarative_Item
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return Project_Nodes.Table (Node).Field2;
end Next_Declarative_Item;
-----------------------------
-- Next_Expression_In_List --
-----------------------------
function Next_Expression_In_List
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Expression);
return Project_Nodes.Table (Node).Field2;
end Next_Expression_In_List;
-------------------------
-- Next_Literal_String --
-------------------------
function Next_Literal_String
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Literal_String);
return Project_Nodes.Table (Node).Field1;
end Next_Literal_String;
-----------------------------
-- Next_Package_In_Project --
-----------------------------
function Next_Package_In_Project
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return Project_Nodes.Table (Node).Field3;
end Next_Package_In_Project;
----------------------
-- Next_String_Type --
----------------------
function Next_String_Type
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
return Project_Nodes.Table (Node).Field2;
end Next_String_Type;
---------------
-- Next_Term --
---------------
function Next_Term
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Term);
return Project_Nodes.Table (Node).Field2;
end Next_Term;
-------------------
-- Next_Variable --
-------------------
function Next_Variable
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
return Project_Nodes.Table (Node).Field3;
end Next_Variable;
-------------------------
-- Next_With_Clause_Of --
-------------------------
function Next_With_Clause_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_With_Clause);
return Project_Nodes.Table (Node).Field2;
end Next_With_Clause_Of;
-------------------
-- Package_Id_Of --
-------------------
function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return Project_Nodes.Table (Node).Pkg_Id;
end Package_Id_Of;
---------------------
-- Package_Node_Of --
---------------------
function Package_Node_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
return Project_Nodes.Table (Node).Field2;
end Package_Node_Of;
------------------
-- Path_Name_Of --
------------------
function Path_Name_Of (Node : Project_Node_Id) return Name_Id is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Project
or else
Project_Nodes.Table (Node).Kind = N_With_Clause));
return Project_Nodes.Table (Node).Path_Name;
end Path_Name_Of;
----------------------------
-- Project_Declaration_Of --
----------------------------
function Project_Declaration_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
return Project_Nodes.Table (Node).Field2;
end Project_Declaration_Of;
---------------------
-- Project_Node_Of --
---------------------
function Project_Node_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_With_Clause
or else
Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
return Project_Nodes.Table (Node).Field1;
end Project_Node_Of;
-----------------------------------
-- Project_Of_Renamed_Package_Of --
-----------------------------------
function Project_Of_Renamed_Package_Of
(Node : Project_Node_Id)
return Project_Node_Id
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return Project_Nodes.Table (Node).Field1;
end Project_Of_Renamed_Package_Of;
------------------------------------
-- Set_Associative_Array_Index_Of --
------------------------------------
procedure Set_Associative_Array_Index_Of
(Node : Project_Node_Id;
To : String_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
Project_Nodes.Table (Node).Value := To;
end Set_Associative_Array_Index_Of;
--------------------------
-- Set_Case_Insensitive --
--------------------------
procedure Set_Case_Insensitive
(Node : Project_Node_Id;
To : Boolean)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
Project_Nodes.Table (Node).Case_Insensitive := To;
end Set_Case_Insensitive;
------------------------------------
-- Set_Case_Variable_Reference_Of --
------------------------------------
procedure Set_Case_Variable_Reference_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Construction);
Project_Nodes.Table (Node).Field1 := To;
end Set_Case_Variable_Reference_Of;
---------------------------
-- Set_Current_Item_Node --
---------------------------
procedure Set_Current_Item_Node
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Declarative_Item);
Project_Nodes.Table (Node).Field1 := To;
end Set_Current_Item_Node;
----------------------
-- Set_Current_Term --
----------------------
procedure Set_Current_Term
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Term);
Project_Nodes.Table (Node).Field1 := To;
end Set_Current_Term;
----------------------
-- Set_Directory_Of --
----------------------
procedure Set_Directory_Of
(Node : Project_Node_Id;
To : Name_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
Project_Nodes.Table (Node).Directory := To;
end Set_Directory_Of;
----------------------------
-- Set_Expression_Kind_Of --
----------------------------
procedure Set_Expression_Kind_Of
(Node : Project_Node_Id;
To : Variable_Kind)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Literal_String
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Expression
or else
Project_Nodes.Table (Node).Kind = N_Term
or else
Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
Project_Nodes.Table (Node).Expr_Kind := To;
end Set_Expression_Kind_Of;
-----------------------
-- Set_Expression_Of --
-----------------------
procedure Set_Expression_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
Project_Nodes.Table (Node).Field1 := To;
end Set_Expression_Of;
-------------------------------
-- Set_External_Reference_Of --
-------------------------------
procedure Set_External_Reference_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_External_Value);
Project_Nodes.Table (Node).Field1 := To;
end Set_External_Reference_Of;
-----------------------------
-- Set_External_Default_Of --
-----------------------------
procedure Set_External_Default_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_External_Value);
Project_Nodes.Table (Node).Field2 := To;
end Set_External_Default_Of;
----------------------------
-- Set_First_Case_Item_Of --
----------------------------
procedure Set_First_Case_Item_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Construction);
Project_Nodes.Table (Node).Field2 := To;
end Set_First_Case_Item_Of;
-------------------------
-- Set_First_Choice_Of --
-------------------------
procedure Set_First_Choice_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Item);
Project_Nodes.Table (Node).Field1 := To;
end Set_First_Choice_Of;
------------------------
-- Set_Next_Case_Item --
------------------------
procedure Set_Next_Case_Item
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Case_Item);
Project_Nodes.Table (Node).Field3 := To;
end Set_Next_Case_Item;
-----------------------------------
-- Set_First_Declarative_Item_Of --
-----------------------------------
procedure Set_First_Declarative_Item_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Case_Item
or else
Project_Nodes.Table (Node).Kind = N_Package_Declaration));
if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
Project_Nodes.Table (Node).Field1 := To;
else
Project_Nodes.Table (Node).Field2 := To;
end if;
end Set_First_Declarative_Item_Of;
----------------------------------
-- Set_First_Expression_In_List --
----------------------------------
procedure Set_First_Expression_In_List
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Literal_String_List);
Project_Nodes.Table (Node).Field1 := To;
end Set_First_Expression_In_List;
------------------------------
-- Set_First_Literal_String --
------------------------------
procedure Set_First_Literal_String
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
Project_Nodes.Table (Node).Field1 := To;
end Set_First_Literal_String;
--------------------------
-- Set_First_Package_Of --
--------------------------
procedure Set_First_Package_Of
(Node : Project_Node_Id;
To : Package_Declaration_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
Project_Nodes.Table (Node).Packages := To;
end Set_First_Package_Of;
------------------------------
-- Set_First_String_Type_Of --
------------------------------
procedure Set_First_String_Type_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
Project_Nodes.Table (Node).Field3 := To;
end Set_First_String_Type_Of;
--------------------
-- Set_First_Term --
--------------------
procedure Set_First_Term
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Expression);
Project_Nodes.Table (Node).Field1 := To;
end Set_First_Term;
---------------------------
-- Set_First_Variable_Of --
---------------------------
procedure Set_First_Variable_Of
(Node : Project_Node_Id;
To : Variable_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Project
or else
Project_Nodes.Table (Node).Kind = N_Package_Declaration));
Project_Nodes.Table (Node).Variables := To;
end Set_First_Variable_Of;
------------------------------
-- Set_First_With_Clause_Of --
------------------------------
procedure Set_First_With_Clause_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
Project_Nodes.Table (Node).Field1 := To;
end Set_First_With_Clause_Of;
-----------------
-- Set_Kind_Of --
-----------------
procedure Set_Kind_Of
(Node : Project_Node_Id;
To : Project_Node_Kind)
is
begin
pragma Assert (Node /= Empty_Node);
Project_Nodes.Table (Node).Kind := To;
end Set_Kind_Of;
---------------------
-- Set_Location_Of --
---------------------
procedure Set_Location_Of
(Node : Project_Node_Id;
To : Source_Ptr)
is
begin
pragma Assert (Node /= Empty_Node);
Project_Nodes.Table (Node).Location := To;
end Set_Location_Of;
-----------------------------
-- Set_Modified_Project_Of --
-----------------------------
procedure Set_Modified_Project_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project_Declaration);
Project_Nodes.Table (Node).Field2 := To;
end Set_Modified_Project_Of;
----------------------------------
-- Set_Modified_Project_Path_Of --
----------------------------------
procedure Set_Modified_Project_Path_Of
(Node : Project_Node_Id;
To : String_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
Project_Nodes.Table (Node).Value := To;
end Set_Modified_Project_Path_Of;
-----------------
-- Set_Name_Of --
-----------------
procedure Set_Name_Of
(Node : Project_Node_Id;
To : Name_Id)
is
begin
pragma Assert (Node /= Empty_Node);
Project_Nodes.Table (Node).Name := To;
end Set_Name_Of;
-------------------------------
-- Set_Next_Declarative_Item --
-------------------------------
procedure Set_Next_Declarative_Item
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Declarative_Item);
Project_Nodes.Table (Node).Field2 := To;
end Set_Next_Declarative_Item;
---------------------------------
-- Set_Next_Expression_In_List --
---------------------------------
procedure Set_Next_Expression_In_List
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Expression);
Project_Nodes.Table (Node).Field2 := To;
end Set_Next_Expression_In_List;
-----------------------------
-- Set_Next_Literal_String --
-----------------------------
procedure Set_Next_Literal_String
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Literal_String);
Project_Nodes.Table (Node).Field1 := To;
end Set_Next_Literal_String;
---------------------------------
-- Set_Next_Package_In_Project --
---------------------------------
procedure Set_Next_Package_In_Project
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Package_Declaration);
Project_Nodes.Table (Node).Field3 := To;
end Set_Next_Package_In_Project;
--------------------------
-- Set_Next_String_Type --
--------------------------
procedure Set_Next_String_Type
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
Project_Nodes.Table (Node).Field2 := To;
end Set_Next_String_Type;
-------------------
-- Set_Next_Term --
-------------------
procedure Set_Next_Term
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Term);
Project_Nodes.Table (Node).Field2 := To;
end Set_Next_Term;
-----------------------
-- Set_Next_Variable --
-----------------------
procedure Set_Next_Variable
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
or else
Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
Project_Nodes.Table (Node).Field3 := To;
end Set_Next_Variable;
-----------------------------
-- Set_Next_With_Clause_Of --
-----------------------------
procedure Set_Next_With_Clause_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_With_Clause);
Project_Nodes.Table (Node).Field2 := To;
end Set_Next_With_Clause_Of;
-----------------------
-- Set_Package_Id_Of --
-----------------------
procedure Set_Package_Id_Of
(Node : Project_Node_Id;
To : Package_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Package_Declaration);
Project_Nodes.Table (Node).Pkg_Id := To;
end Set_Package_Id_Of;
-------------------------
-- Set_Package_Node_Of --
-------------------------
procedure Set_Package_Node_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
Project_Nodes.Table (Node).Field2 := To;
end Set_Package_Node_Of;
----------------------
-- Set_Path_Name_Of --
----------------------
procedure Set_Path_Name_Of
(Node : Project_Node_Id;
To : Name_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Project
or else
Project_Nodes.Table (Node).Kind = N_With_Clause));
Project_Nodes.Table (Node).Path_Name := To;
end Set_Path_Name_Of;
--------------------------------
-- Set_Project_Declaration_Of --
--------------------------------
procedure Set_Project_Declaration_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Project);
Project_Nodes.Table (Node).Field2 := To;
end Set_Project_Declaration_Of;
-------------------------
-- Set_Project_Node_Of --
-------------------------
procedure Set_Project_Node_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_With_Clause
or else
Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
Project_Nodes.Table (Node).Field1 := To;
end Set_Project_Node_Of;
---------------------------------------
-- Set_Project_Of_Renamed_Package_Of --
---------------------------------------
procedure Set_Project_Of_Renamed_Package_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
Project_Nodes.Table (Node).Kind = N_Package_Declaration);
Project_Nodes.Table (Node).Field1 := To;
end Set_Project_Of_Renamed_Package_Of;
------------------------
-- Set_String_Type_Of --
------------------------
procedure Set_String_Type_Of
(Node : Project_Node_Id;
To : Project_Node_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)
and then
Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
Project_Nodes.Table (Node).Field3 := To;
else
Project_Nodes.Table (Node).Field2 := To;
end if;
end Set_String_Type_Of;
-------------------------
-- Set_String_Value_Of --
-------------------------
procedure Set_String_Value_Of
(Node : Project_Node_Id;
To : String_Id)
is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_With_Clause
or else
Project_Nodes.Table (Node).Kind = N_Literal_String));
Project_Nodes.Table (Node).Value := To;
end Set_String_Value_Of;
--------------------
-- String_Type_Of --
--------------------
function String_Type_Of (Node : Project_Node_Id)
return Project_Node_Id is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration));
if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
return Project_Nodes.Table (Node).Field3;
else
return Project_Nodes.Table (Node).Field2;
end if;
end String_Type_Of;
---------------------
-- String_Value_Of --
---------------------
function String_Value_Of (Node : Project_Node_Id) return String_Id is
begin
pragma Assert
(Node /= Empty_Node
and then
(Project_Nodes.Table (Node).Kind = N_With_Clause
or else
Project_Nodes.Table (Node).Kind = N_Literal_String));
return Project_Nodes.Table (Node).Value;
end String_Value_Of;
--------------------
-- Value_Is_Valid --
--------------------
function Value_Is_Valid
(For_Typed_Variable : Project_Node_Id;
Value : String_Id)
return Boolean
is
begin
pragma Assert
(For_Typed_Variable /= Empty_Node
and then
(Project_Nodes.Table (For_Typed_Variable).Kind =
N_Typed_Variable_Declaration));
declare
Current_String : Project_Node_Id :=
First_Literal_String
(String_Type_Of (For_Typed_Variable));
begin
while Current_String /= Empty_Node
and then
not String_Equal (String_Value_Of (Current_String), Value)
loop
Current_String :=
Next_Literal_String (Current_String);
end loop;
return Current_String /= Empty_Node;
end;
end Value_Is_Valid;
end Prj.Tree;
Reference in New Issue View Git Blame Copy Permalink