-- --
-- B o d y --
-- --
--- $Revision: 1.7 $
--- --
--- Copyright (C) 2001 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2010, 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- --
+-- ware Foundation; either version 3, 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. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- 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). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Stringt; use Stringt;
+with Osint; use Osint;
+with Prj.Env; use Prj.Env;
+with Prj.Err;
+
+with Ada.Unchecked_Deallocation;
package body Prj.Tree is
+ Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
+ (N_Project => True,
+ N_With_Clause => True,
+ N_Project_Declaration => False,
+ N_Declarative_Item => False,
+ N_Package_Declaration => True,
+ N_String_Type_Declaration => True,
+ N_Literal_String => False,
+ N_Attribute_Declaration => True,
+ N_Typed_Variable_Declaration => True,
+ N_Variable_Declaration => True,
+ N_Expression => False,
+ N_Term => False,
+ N_Literal_String_List => False,
+ N_Variable_Reference => False,
+ N_External_Value => False,
+ N_Attribute_Reference => False,
+ N_Case_Construction => True,
+ N_Case_Item => True,
+ N_Comment_Zones => True,
+ N_Comment => True);
+ -- Indicates the kinds of node that may have associated comments
+
+ package Next_End_Nodes is new Table.Table
+ (Table_Component_Type => Project_Node_Id,
+ Table_Index_Type => Natural,
+ Table_Low_Bound => 1,
+ Table_Initial => 10,
+ Table_Increment => 100,
+ Table_Name => "Next_End_Nodes");
+ -- A stack of nodes to indicates to what node the next "end" is associated
+
use Tree_Private_Part;
+ End_Of_Line_Node : Project_Node_Id := Empty_Node;
+ -- The node an end of line comment may be associated with
+
+ Previous_Line_Node : Project_Node_Id := Empty_Node;
+ -- The node an immediately following comment may be associated with
+
+ Previous_End_Node : Project_Node_Id := Empty_Node;
+ -- The node comments immediately following an "end" line may be
+ -- associated with.
+
+ Unkept_Comments : Boolean := False;
+ -- Set to True when some comments may not be associated with any node
+
+ function Comment_Zones_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
+ -- Returns the ID of the N_Comment_Zones node associated with node Node.
+ -- If there is not already an N_Comment_Zones node, create one and
+ -- associate it with node Node.
+
+ ------------------
+ -- Add_Comments --
+ ------------------
+
+ procedure Add_Comments
+ (To : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ Where : Comment_Location) is
+ Zone : Project_Node_Id := Empty_Node;
+ Previous : Project_Node_Id := Empty_Node;
+
+ begin
+ pragma Assert
+ (Present (To)
+ and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
+
+ Zone := In_Tree.Project_Nodes.Table (To).Comments;
+
+ if No (Zone) then
+
+ -- Create new N_Comment_Zones node
+
+ Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table
+ (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
+ (Kind => N_Comment_Zones,
+ Qualifier => Unspecified,
+ Expr_Kind => Undefined,
+ Location => No_Location,
+ Directory => No_Path,
+ Variables => Empty_Node,
+ Packages => Empty_Node,
+ Pkg_Id => Empty_Package,
+ Name => No_Name,
+ Src_Index => 0,
+ Path_Name => No_Path,
+ Value => No_Name,
+ Field1 => Empty_Node,
+ Field2 => Empty_Node,
+ Field3 => Empty_Node,
+ Field4 => Empty_Node,
+ Flag1 => False,
+ Flag2 => False,
+ Comments => Empty_Node);
+
+ Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table (To).Comments := Zone;
+ end if;
+
+ if Where = End_Of_Line then
+ In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
+
+ else
+ -- Get each comments in the Comments table and link them to node To
+
+ for J in 1 .. Comments.Last loop
+
+ -- Create new N_Comment node
+
+ if (Where = After or else Where = After_End) and then
+ Token /= Tok_EOF and then
+ Comments.Table (J).Follows_Empty_Line
+ then
+ Comments.Table (1 .. Comments.Last - J + 1) :=
+ Comments.Table (J .. Comments.Last);
+ Comments.Set_Last (Comments.Last - J + 1);
+ return;
+ end if;
+
+ Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table
+ (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
+ (Kind => N_Comment,
+ Qualifier => Unspecified,
+ Expr_Kind => Undefined,
+ Flag1 => Comments.Table (J).Follows_Empty_Line,
+ Flag2 =>
+ Comments.Table (J).Is_Followed_By_Empty_Line,
+ Location => No_Location,
+ Directory => No_Path,
+ Variables => Empty_Node,
+ Packages => Empty_Node,
+ Pkg_Id => Empty_Package,
+ Name => No_Name,
+ Src_Index => 0,
+ Path_Name => No_Path,
+ Value => Comments.Table (J).Value,
+ Field1 => Empty_Node,
+ Field2 => Empty_Node,
+ Field3 => Empty_Node,
+ Field4 => Empty_Node,
+ Comments => Empty_Node);
+
+ -- If this is the first comment, put it in the right field of
+ -- the node Zone.
+
+ if No (Previous) then
+ case Where is
+ when Before =>
+ In_Tree.Project_Nodes.Table (Zone).Field1 :=
+ Project_Node_Table.Last (In_Tree.Project_Nodes);
+
+ when After =>
+ In_Tree.Project_Nodes.Table (Zone).Field2 :=
+ Project_Node_Table.Last (In_Tree.Project_Nodes);
+
+ when Before_End =>
+ In_Tree.Project_Nodes.Table (Zone).Field3 :=
+ Project_Node_Table.Last (In_Tree.Project_Nodes);
+
+ when After_End =>
+ In_Tree.Project_Nodes.Table (Zone).Comments :=
+ Project_Node_Table.Last (In_Tree.Project_Nodes);
+
+ when End_Of_Line =>
+ null;
+ end case;
+
+ else
+ -- When it is not the first, link it to the previous one
+
+ In_Tree.Project_Nodes.Table (Previous).Comments :=
+ Project_Node_Table.Last (In_Tree.Project_Nodes);
+ end if;
+
+ -- This node becomes the previous one for the next comment, if
+ -- there is one.
+
+ Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
+ end loop;
+ end if;
+
+ -- Empty the Comments table, so that there is no risk to link the same
+ -- comments to another node.
+
+ Comments.Set_Last (0);
+ end Add_Comments;
+
--------------------------------
-- Associative_Array_Index_Of --
--------------------------------
function Associative_Array_Index_Of
- (Node : Project_Node_Id)
- return String_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Name_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
- return Project_Nodes.Table (Node).Value;
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ return In_Tree.Project_Nodes.Table (Node).Value;
end Associative_Array_Index_Of;
+ ----------------------------
+ -- Associative_Package_Of --
+ ----------------------------
+
+ function Associative_Package_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
+ return In_Tree.Project_Nodes.Table (Node).Field3;
+ end Associative_Package_Of;
+
+ ----------------------------
+ -- Associative_Project_Of --
+ ----------------------------
+
+ function Associative_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
+ return In_Tree.Project_Nodes.Table (Node).Field2;
+ end Associative_Project_Of;
+
+ ----------------------
+ -- Case_Insensitive --
+ ----------------------
+
+ function Case_Insensitive
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Boolean is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ return In_Tree.Project_Nodes.Table (Node).Flag1;
+ end Case_Insensitive;
+
--------------------------------
-- Case_Variable_Reference_Of --
--------------------------------
function Case_Variable_Reference_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Construction);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end Case_Variable_Reference_Of;
+ ----------------------
+ -- Comment_Zones_Of --
+ ----------------------
+
+ function Comment_Zones_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ Zone : Project_Node_Id;
+
+ begin
+ pragma Assert (Present (Node));
+ Zone := In_Tree.Project_Nodes.Table (Node).Comments;
+
+ -- If there is not already an N_Comment_Zones associated, create a new
+ -- one and associate it with node Node.
+
+ if No (Zone) then
+ Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
+ Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table (Zone) :=
+ (Kind => N_Comment_Zones,
+ Qualifier => Unspecified,
+ Location => No_Location,
+ Directory => No_Path,
+ Expr_Kind => Undefined,
+ Variables => Empty_Node,
+ Packages => Empty_Node,
+ Pkg_Id => Empty_Package,
+ Name => No_Name,
+ Src_Index => 0,
+ Path_Name => No_Path,
+ Value => No_Name,
+ Field1 => Empty_Node,
+ Field2 => Empty_Node,
+ Field3 => Empty_Node,
+ Field4 => Empty_Node,
+ Flag1 => False,
+ Flag2 => False,
+ Comments => Empty_Node);
+ In_Tree.Project_Nodes.Table (Node).Comments := Zone;
+ end if;
+
+ return Zone;
+ end Comment_Zones_Of;
+
-----------------------
-- Current_Item_Node --
-----------------------
function Current_Item_Node
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Declarative_Item);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end Current_Item_Node;
------------------
------------------
function Current_Term
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Term);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end Current_Term;
--------------------------
--------------------------
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);
- return Project_Nodes.Last;
+ (In_Tree : Project_Node_Tree_Ref;
+ Of_Kind : Project_Node_Kind;
+ And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
+ is
+ Result : Project_Node_Id;
+ Zone : Project_Node_Id;
+ Previous : Project_Node_Id;
+
+ begin
+ -- Create new node with specified kind and expression kind
+
+ Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table
+ (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
+ (Kind => Of_Kind,
+ Qualifier => Unspecified,
+ Location => No_Location,
+ Directory => No_Path,
+ Expr_Kind => And_Expr_Kind,
+ Variables => Empty_Node,
+ Packages => Empty_Node,
+ Pkg_Id => Empty_Package,
+ Name => No_Name,
+ Src_Index => 0,
+ Path_Name => No_Path,
+ Value => No_Name,
+ Field1 => Empty_Node,
+ Field2 => Empty_Node,
+ Field3 => Empty_Node,
+ Field4 => Empty_Node,
+ Flag1 => False,
+ Flag2 => False,
+ Comments => Empty_Node);
+
+ -- Save the new node for the returned value
+
+ Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
+
+ if Comments.Last > 0 then
+
+ -- If this is not a node with comments, then set the flag
+
+ if not Node_With_Comments (Of_Kind) then
+ Unkept_Comments := True;
+
+ elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
+
+ Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table
+ (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
+ (Kind => N_Comment_Zones,
+ Qualifier => Unspecified,
+ Expr_Kind => Undefined,
+ Location => No_Location,
+ Directory => No_Path,
+ Variables => Empty_Node,
+ Packages => Empty_Node,
+ Pkg_Id => Empty_Package,
+ Name => No_Name,
+ Src_Index => 0,
+ Path_Name => No_Path,
+ Value => No_Name,
+ Field1 => Empty_Node,
+ Field2 => Empty_Node,
+ Field3 => Empty_Node,
+ Field4 => Empty_Node,
+ Flag1 => False,
+ Flag2 => False,
+ Comments => Empty_Node);
+
+ Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table (Result).Comments := Zone;
+ Previous := Empty_Node;
+
+ for J in 1 .. Comments.Last loop
+
+ -- Create a new N_Comment node
+
+ Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
+ In_Tree.Project_Nodes.Table
+ (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
+ (Kind => N_Comment,
+ Qualifier => Unspecified,
+ Expr_Kind => Undefined,
+ Flag1 => Comments.Table (J).Follows_Empty_Line,
+ Flag2 =>
+ Comments.Table (J).Is_Followed_By_Empty_Line,
+ Location => No_Location,
+ Directory => No_Path,
+ Variables => Empty_Node,
+ Packages => Empty_Node,
+ Pkg_Id => Empty_Package,
+ Name => No_Name,
+ Src_Index => 0,
+ Path_Name => No_Path,
+ Value => Comments.Table (J).Value,
+ Field1 => Empty_Node,
+ Field2 => Empty_Node,
+ Field3 => Empty_Node,
+ Field4 => Empty_Node,
+ Comments => Empty_Node);
+
+ -- Link it to the N_Comment_Zones node, if it is the first,
+ -- otherwise to the previous one.
+
+ if No (Previous) then
+ In_Tree.Project_Nodes.Table (Zone).Field1 :=
+ Project_Node_Table.Last (In_Tree.Project_Nodes);
+
+ else
+ In_Tree.Project_Nodes.Table (Previous).Comments :=
+ Project_Node_Table.Last (In_Tree.Project_Nodes);
+ end if;
+
+ -- This new node will be the previous one for the next
+ -- N_Comment node, if there is one.
+
+ Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
+ end loop;
+
+ -- Empty the Comments table after all comments have been processed
+
+ Comments.Set_Last (0);
+ end if;
+ end if;
+
+ return Result;
end Default_Project_Node;
------------------
-- Directory_Of --
------------------
- function Directory_Of (Node : Project_Node_Id) return Name_Id is
+ function Directory_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- return Project_Nodes.Table (Node).Directory;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return In_Tree.Project_Nodes.Table (Node).Directory;
end Directory_Of;
+ -------------------------
+ -- End_Of_Line_Comment --
+ -------------------------
+
+ function End_Of_Line_Comment
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Name_Id is
+ Zone : Project_Node_Id := Empty_Node;
+
+ begin
+ pragma Assert (Present (Node));
+ Zone := In_Tree.Project_Nodes.Table (Node).Comments;
+
+ if No (Zone) then
+ return No_Name;
+ else
+ return In_Tree.Project_Nodes.Table (Zone).Value;
+ end if;
+ end End_Of_Line_Comment;
+
------------------------
-- Expression_Kind_Of --
------------------------
- function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind is
+ function Expression_Kind_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Literal_String
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Declaration
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Typed_Variable_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Expression
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
or else
- Project_Nodes.Table (Node).Kind = N_Term
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Term
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Attribute_Reference));
- return Project_Nodes.Table (Node).Expr_Kind;
+ return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
end Expression_Kind_Of;
-------------------
-------------------
function Expression_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ (In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Attribute_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Typed_Variable_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Variable_Declaration));
- return Project_Nodes.Table (Node).Field1;
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end Expression_Of;
+ -------------------------
+ -- Extended_Project_Of --
+ -------------------------
+
+ function Extended_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
+ end Extended_Project_Of;
+
+ ------------------------------
+ -- Extended_Project_Path_Of --
+ ------------------------------
+
+ function Extended_Project_Path_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
+ end Extended_Project_Path_Of;
+
+ --------------------------
+ -- Extending_Project_Of --
+ --------------------------
+ function Extending_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
+ return In_Tree.Project_Nodes.Table (Node).Field3;
+ end Extending_Project_Of;
+
---------------------------
-- External_Reference_Of --
---------------------------
function External_Reference_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_External_Value);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end External_Reference_Of;
-------------------------
-------------------------
function External_Default_Of
- (Node : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_External_Value);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end External_Default_Of;
------------------------
------------------------
function First_Case_Item_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Construction);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end First_Case_Item_Of;
---------------------
---------------------
function First_Choice_Of
- (Node : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Item);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end First_Choice_Of;
+ -------------------------
+ -- First_Comment_After --
+ -------------------------
+
+ function First_Comment_After
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ Zone : Project_Node_Id := Empty_Node;
+ begin
+ pragma Assert (Present (Node));
+ Zone := In_Tree.Project_Nodes.Table (Node).Comments;
+
+ if No (Zone) then
+ return Empty_Node;
+
+ else
+ return In_Tree.Project_Nodes.Table (Zone).Field2;
+ end if;
+ end First_Comment_After;
+
+ -----------------------------
+ -- First_Comment_After_End --
+ -----------------------------
+
+ function First_Comment_After_End
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
+ return Project_Node_Id
+ is
+ Zone : Project_Node_Id := Empty_Node;
+
+ begin
+ pragma Assert (Present (Node));
+ Zone := In_Tree.Project_Nodes.Table (Node).Comments;
+
+ if No (Zone) then
+ return Empty_Node;
+
+ else
+ return In_Tree.Project_Nodes.Table (Zone).Comments;
+ end if;
+ end First_Comment_After_End;
+
+ --------------------------
+ -- First_Comment_Before --
+ --------------------------
+
+ function First_Comment_Before
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ Zone : Project_Node_Id := Empty_Node;
+
+ begin
+ pragma Assert (Present (Node));
+ Zone := In_Tree.Project_Nodes.Table (Node).Comments;
+
+ if No (Zone) then
+ return Empty_Node;
+
+ else
+ return In_Tree.Project_Nodes.Table (Zone).Field1;
+ end if;
+ end First_Comment_Before;
+
+ ------------------------------
+ -- First_Comment_Before_End --
+ ------------------------------
+
+ function First_Comment_Before_End
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ Zone : Project_Node_Id := Empty_Node;
+
+ begin
+ pragma Assert (Present (Node));
+ Zone := In_Tree.Project_Nodes.Table (Node).Comments;
+
+ if No (Zone) then
+ return Empty_Node;
+
+ else
+ return In_Tree.Project_Nodes.Table (Zone).Field3;
+ end if;
+ end First_Comment_Before_End;
+
-------------------------------
-- First_Declarative_Item_Of --
-------------------------------
function First_Declarative_Item_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Project_Declaration
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Case_Item
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
or else
- Project_Nodes.Table (Node).Kind = N_Package_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
- if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
- return Project_Nodes.Table (Node).Field1;
+ if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
+ return In_Tree.Project_Nodes.Table (Node).Field1;
else
- return Project_Nodes.Table (Node).Field2;
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end if;
end First_Declarative_Item_Of;
------------------------------
function First_Expression_In_List
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Literal_String_List);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end First_Expression_In_List;
--------------------------
--------------------------
function First_Literal_String
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_String_Type_Declaration);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end First_Literal_String;
----------------------
----------------------
function First_Package_Of
- (Node : Project_Node_Id)
- return Package_Declaration_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- return Project_Nodes.Table (Node).Packages;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return In_Tree.Project_Nodes.Table (Node).Packages;
end First_Package_Of;
--------------------------
--------------------------
function First_String_Type_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- return Project_Nodes.Table (Node).Field3;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return In_Tree.Project_Nodes.Table (Node).Field3;
end First_String_Type_Of;
----------------
----------------
function First_Term
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Expression);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end First_Term;
-----------------------
-----------------------
function First_Variable_Of
- (Node : Project_Node_Id)
- return Variable_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Project
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
- Project_Nodes.Table (Node).Kind = N_Package_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
- return Project_Nodes.Table (Node).Variables;
+ return In_Tree.Project_Nodes.Table (Node).Variables;
end First_Variable_Of;
--------------------------
--------------------------
function First_With_Clause_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end First_With_Clause_Of;
+ ------------------------
+ -- Follows_Empty_Line --
+ ------------------------
+
+ function Follows_Empty_Line
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Boolean is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
+ return In_Tree.Project_Nodes.Table (Node).Flag1;
+ end Follows_Empty_Line;
+
+ ----------
+ -- Hash --
+ ----------
+
+ function Hash (N : Project_Node_Id) return Header_Num is
+ begin
+ return Header_Num (N mod Project_Node_Id (Header_Num'Last));
+ end Hash;
+
----------------
-- Initialize --
----------------
- procedure Initialize is
+ procedure Initialize (Tree : Project_Node_Tree_Ref) is
begin
- Project_Nodes.Set_Last (Empty_Node);
- Projects_Htable.Reset;
+ Project_Node_Table.Init (Tree.Project_Nodes);
+ Projects_Htable.Reset (Tree.Projects_HT);
+
+ -- Do not reset the external references, in case we are reloading a
+ -- project, since we want to preserve the current environment
+ -- Name_To_Name_HTable.Reset (Tree.External_References);
end Initialize;
- -------------
- -- Kind_Of --
- -------------
+ ----------
+ -- Free --
+ ----------
- function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is
+ procedure Free (Proj : in out Project_Node_Tree_Ref) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Project_Node_Tree_Data, Project_Node_Tree_Ref);
begin
- pragma Assert (Node /= Empty_Node);
- return Project_Nodes.Table (Node).Kind;
- end Kind_Of;
+ if Proj /= null then
+ Project_Node_Table.Free (Proj.Project_Nodes);
+ Projects_Htable.Reset (Proj.Projects_HT);
+ Name_To_Name_HTable.Reset (Proj.External_References);
+ Free (Proj.Project_Path);
+ Unchecked_Free (Proj);
+ end if;
+ end Free;
- -----------------
- -- Location_Of --
- -----------------
+ -------------------------------
+ -- Is_Followed_By_Empty_Line --
+ -------------------------------
- function Location_Of (Node : Project_Node_Id) return Source_Ptr is
+ function Is_Followed_By_Empty_Line
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Boolean
+ is
begin
- pragma Assert (Node /= Empty_Node);
- return Project_Nodes.Table (Node).Location;
- end Location_Of;
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
+ return In_Tree.Project_Nodes.Table (Node).Flag2;
+ end Is_Followed_By_Empty_Line;
+
+ ----------------------
+ -- Is_Extending_All --
+ ----------------------
+
+ function Is_Extending_All
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Boolean is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
+ return In_Tree.Project_Nodes.Table (Node).Flag2;
+ end Is_Extending_All;
-------------------------
- -- Modified_Project_Of --
+ -- Is_Not_Last_In_List --
-------------------------
- function Modified_Project_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
- is
+ function Is_Not_Last_In_List
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project_Declaration);
- return Project_Nodes.Table (Node).Field2;
- end Modified_Project_Of;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
+ return In_Tree.Project_Nodes.Table (Node).Flag1;
+ end Is_Not_Last_In_List;
- ------------------------------
- -- Modified_Project_Path_Of --
- ------------------------------
+ -------------------------------------
+ -- Imported_Or_Extended_Project_Of --
+ -------------------------------------
- function Modified_Project_Path_Of
- (Node : Project_Node_Id)
- return String_Id
+ function Imported_Or_Extended_Project_Of
+ (Project : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ With_Name : Name_Id) return Project_Node_Id
is
+ With_Clause : Project_Node_Id :=
+ First_With_Clause_Of (Project, In_Tree);
+ Result : Project_Node_Id := Empty_Node;
+
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;
+ -- First check all the imported projects
+
+ while Present (With_Clause) loop
+
+ -- Only non limited imported project may be used as prefix
+ -- of variable or attributes.
+
+ Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
+ exit when Present (Result)
+ and then Name_Of (Result, In_Tree) = With_Name;
+ With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
+ end loop;
+
+ -- If it is not an imported project, it might be an extended project
+
+ if No (With_Clause) then
+ Result := Project;
+ loop
+ Result :=
+ Extended_Project_Of
+ (Project_Declaration_Of (Result, In_Tree), In_Tree);
+
+ exit when No (Result)
+ or else Name_Of (Result, In_Tree) = With_Name;
+ end loop;
+ end if;
+
+ return Result;
+ end Imported_Or_Extended_Project_Of;
+
+ -------------
+ -- Kind_Of --
+ -------------
+
+ function Kind_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
+ begin
+ pragma Assert (Present (Node));
+ return In_Tree.Project_Nodes.Table (Node).Kind;
+ end Kind_Of;
+
+ -----------------
+ -- Location_Of --
+ -----------------
+
+ function Location_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
+ begin
+ pragma Assert (Present (Node));
+ return In_Tree.Project_Nodes.Table (Node).Location;
+ end Location_Of;
-------------
-- Name_Of --
-------------
- function Name_Of (Node : Project_Node_Id) return Name_Id is
+ function Name_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Name_Id is
begin
- pragma Assert (Node /= Empty_Node);
- return Project_Nodes.Table (Node).Name;
+ pragma Assert (Present (Node));
+ return In_Tree.Project_Nodes.Table (Node).Name;
end Name_Of;
--------------------
--------------------
function Next_Case_Item
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Item);
- return Project_Nodes.Table (Node).Field3;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
+ return In_Tree.Project_Nodes.Table (Node).Field3;
end Next_Case_Item;
+ ------------------
+ -- Next_Comment --
+ ------------------
+
+ function Next_Comment
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
+ return In_Tree.Project_Nodes.Table (Node).Comments;
+ end Next_Comment;
+
---------------------------
-- Next_Declarative_Item --
---------------------------
function Next_Declarative_Item
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Declarative_Item);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end Next_Declarative_Item;
-----------------------------
-----------------------------
function Next_Expression_In_List
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Expression);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end Next_Expression_In_List;
-------------------------
-------------------------
function Next_Literal_String
- (Node : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Literal_String);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end Next_Literal_String;
-----------------------------
-----------------------------
function Next_Package_In_Project
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Package_Declaration);
- return Project_Nodes.Table (Node).Field3;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
+ return In_Tree.Project_Nodes.Table (Node).Field3;
end Next_Package_In_Project;
----------------------
----------------------
function Next_String_Type
- (Node : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_String_Type_Declaration);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end Next_String_Type;
---------------
---------------
function Next_Term
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Term);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end Next_Term;
-------------------
-------------------
function Next_Variable
- (Node : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
+ (In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Typed_Variable_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Variable_Declaration));
- return Project_Nodes.Table (Node).Field3;
+ return In_Tree.Project_Nodes.Table (Node).Field3;
end Next_Variable;
-------------------------
-------------------------
function Next_With_Clause_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_With_Clause);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end Next_With_Clause_Of;
+ --------
+ -- No --
+ --------
+
+ function No (Node : Project_Node_Id) return Boolean is
+ begin
+ return Node = Empty_Node;
+ end No;
+
+ ---------------------------------
+ -- Non_Limited_Project_Node_Of --
+ ---------------------------------
+
+ function Non_Limited_Project_Node_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
+ return In_Tree.Project_Nodes.Table (Node).Field3;
+ end Non_Limited_Project_Node_Of;
+
-------------------
-- Package_Id_Of --
-------------------
- function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is
+ function Package_Id_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
+ is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Package_Declaration);
- return Project_Nodes.Table (Node).Pkg_Id;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
+ return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
end Package_Id_Of;
---------------------
---------------------
function Package_Node_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end Package_Node_Of;
------------------
-- Path_Name_Of --
------------------
- function Path_Name_Of (Node : Project_Node_Id) return Name_Id is
+ function Path_Name_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
+ is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Project
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
- Project_Nodes.Table (Node).Kind = N_With_Clause));
- return Project_Nodes.Table (Node).Path_Name;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
+ return In_Tree.Project_Nodes.Table (Node).Path_Name;
end Path_Name_Of;
+ -------------
+ -- Present --
+ -------------
+
+ function Present (Node : Project_Node_Id) return Boolean is
+ begin
+ return Node /= Empty_Node;
+ end Present;
+
----------------------------
-- Project_Declaration_Of --
----------------------------
function Project_Declaration_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- return Project_Nodes.Table (Node).Field2;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return In_Tree.Project_Nodes.Table (Node).Field2;
end Project_Declaration_Of;
+ --------------------------
+ -- Project_Qualifier_Of --
+ --------------------------
+
+ function Project_Qualifier_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return In_Tree.Project_Nodes.Table (Node).Qualifier;
+ end Project_Qualifier_Of;
+
+ -----------------------
+ -- Parent_Project_Of --
+ -----------------------
+
+ function Parent_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ return In_Tree.Project_Nodes.Table (Node).Field4;
+ end Parent_Project_Of;
+
+ -------------------------------------------
+ -- Project_File_Includes_Unkept_Comments --
+ -------------------------------------------
+
+ function Project_File_Includes_Unkept_Comments
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Boolean
+ is
+ Declaration : constant Project_Node_Id :=
+ Project_Declaration_Of (Node, In_Tree);
+ begin
+ return In_Tree.Project_Nodes.Table (Declaration).Flag1;
+ end Project_File_Includes_Unkept_Comments;
+
---------------------
-- Project_Node_Of --
---------------------
function Project_Node_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_With_Clause
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end Project_Node_Of;
-----------------------------------
-----------------------------------
function Project_Of_Renamed_Package_Of
- (Node : Project_Node_Id)
- return Project_Node_Id
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Package_Declaration);
- return Project_Nodes.Table (Node).Field1;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
+ return In_Tree.Project_Nodes.Table (Node).Field1;
end Project_Of_Renamed_Package_Of;
+ --------------------------
+ -- Remove_Next_End_Node --
+ --------------------------
+
+ procedure Remove_Next_End_Node is
+ begin
+ Next_End_Nodes.Decrement_Last;
+ end Remove_Next_End_Node;
+
+ -----------------
+ -- Reset_State --
+ -----------------
+
+ procedure Reset_State is
+ begin
+ End_Of_Line_Node := Empty_Node;
+ Previous_Line_Node := Empty_Node;
+ Previous_End_Node := Empty_Node;
+ Unkept_Comments := False;
+ Comments.Set_Last (0);
+ end Reset_State;
+
+ ----------------------
+ -- Restore_And_Free --
+ ----------------------
+
+ procedure Restore_And_Free (S : in out Comment_State) is
+ procedure Unchecked_Free is new
+ Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
+
+ begin
+ End_Of_Line_Node := S.End_Of_Line_Node;
+ Previous_Line_Node := S.Previous_Line_Node;
+ Previous_End_Node := S.Previous_End_Node;
+ Next_End_Nodes.Set_Last (0);
+ Unkept_Comments := S.Unkept_Comments;
+
+ Comments.Set_Last (0);
+
+ for J in S.Comments'Range loop
+ Comments.Increment_Last;
+ Comments.Table (Comments.Last) := S.Comments (J);
+ end loop;
+
+ Unchecked_Free (S.Comments);
+ end Restore_And_Free;
+
+ ----------
+ -- Save --
+ ----------
+
+ procedure Save (S : out Comment_State) is
+ Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
+
+ begin
+ for J in 1 .. Comments.Last loop
+ Cmts (J) := Comments.Table (J);
+ end loop;
+
+ S :=
+ (End_Of_Line_Node => End_Of_Line_Node,
+ Previous_Line_Node => Previous_Line_Node,
+ Previous_End_Node => Previous_End_Node,
+ Unkept_Comments => Unkept_Comments,
+ Comments => Cmts);
+ end Save;
+
+ ----------
+ -- Scan --
+ ----------
+
+ procedure Scan (In_Tree : Project_Node_Tree_Ref) is
+ Empty_Line : Boolean := False;
+
+ begin
+ -- If there are comments, then they will not be kept. Set the flag and
+ -- clear the comments.
+
+ if Comments.Last > 0 then
+ Unkept_Comments := True;
+ Comments.Set_Last (0);
+ end if;
+
+ -- Loop until a token other that End_Of_Line or Comment is found
+
+ loop
+ Prj.Err.Scanner.Scan;
+
+ case Token is
+ when Tok_End_Of_Line =>
+ if Prev_Token = Tok_End_Of_Line then
+ Empty_Line := True;
+
+ if Comments.Last > 0 then
+ Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
+ := True;
+ end if;
+ end if;
+
+ when Tok_Comment =>
+ -- If this is a line comment, add it to the comment table
+
+ if Prev_Token = Tok_End_Of_Line
+ or else Prev_Token = No_Token
+ then
+ Comments.Increment_Last;
+ Comments.Table (Comments.Last) :=
+ (Value => Comment_Id,
+ Follows_Empty_Line => Empty_Line,
+ Is_Followed_By_Empty_Line => False);
+
+ -- Otherwise, it is an end of line comment. If there is
+ -- an end of line node specified, associate the comment with
+ -- this node.
+
+ elsif Present (End_Of_Line_Node) then
+ declare
+ Zones : constant Project_Node_Id :=
+ Comment_Zones_Of (End_Of_Line_Node, In_Tree);
+ begin
+ In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
+ end;
+
+ -- Otherwise, this end of line node cannot be kept
+
+ else
+ Unkept_Comments := True;
+ Comments.Set_Last (0);
+ end if;
+
+ Empty_Line := False;
+
+ when others =>
+ -- If there are comments, where the first comment is not
+ -- following an empty line, put the initial uninterrupted
+ -- comment zone with the node of the preceding line (either
+ -- a Previous_Line or a Previous_End node), if any.
+
+ if Comments.Last > 0 and then
+ not Comments.Table (1).Follows_Empty_Line then
+ if Present (Previous_Line_Node) then
+ Add_Comments
+ (To => Previous_Line_Node,
+ Where => After,
+ In_Tree => In_Tree);
+
+ elsif Present (Previous_End_Node) then
+ Add_Comments
+ (To => Previous_End_Node,
+ Where => After_End,
+ In_Tree => In_Tree);
+ end if;
+ end if;
+
+ -- If there are still comments and the token is "end", then
+ -- put these comments with the Next_End node, if any;
+ -- otherwise, these comments cannot be kept. Always clear
+ -- the comments.
+
+ if Comments.Last > 0 and then Token = Tok_End then
+ if Next_End_Nodes.Last > 0 then
+ Add_Comments
+ (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
+ Where => Before_End,
+ In_Tree => In_Tree);
+
+ else
+ Unkept_Comments := True;
+ end if;
+
+ Comments.Set_Last (0);
+ end if;
+
+ -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
+ -- so that they are not used again.
+
+ End_Of_Line_Node := Empty_Node;
+ Previous_Line_Node := Empty_Node;
+ Previous_End_Node := Empty_Node;
+
+ -- And return
+
+ exit;
+ end case;
+ end loop;
+ end Scan;
+
------------------------------------
-- Set_Associative_Array_Index_Of --
------------------------------------
procedure Set_Associative_Array_Index_Of
- (Node : Project_Node_Id;
- To : String_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Name_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
- Project_Nodes.Table (Node).Value := To;
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ In_Tree.Project_Nodes.Table (Node).Value := To;
end Set_Associative_Array_Index_Of;
+ --------------------------------
+ -- Set_Associative_Package_Of --
+ --------------------------------
+
+ procedure Set_Associative_Package_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
+ end Set_Associative_Package_Of;
+
+ --------------------------------
+ -- Set_Associative_Project_Of --
+ --------------------------------
+
+ procedure Set_Associative_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Attribute_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
+ end Set_Associative_Project_Of;
+
+ --------------------------
+ -- Set_Case_Insensitive --
+ --------------------------
+
+ procedure Set_Case_Insensitive
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Boolean)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ In_Tree.Project_Nodes.Table (Node).Flag1 := To;
+ end Set_Case_Insensitive;
+
------------------------------------
-- Set_Case_Variable_Reference_Of --
------------------------------------
procedure Set_Case_Variable_Reference_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Construction);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_Case_Variable_Reference_Of;
---------------------------
---------------------------
procedure Set_Current_Item_Node
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Declarative_Item);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_Current_Item_Node;
----------------------
----------------------
procedure Set_Current_Term
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Term);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_Current_Term;
----------------------
----------------------
procedure Set_Directory_Of
- (Node : Project_Node_Id;
- To : Name_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Path_Name_Type)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- Project_Nodes.Table (Node).Directory := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Directory := To;
end Set_Directory_Of;
+ ---------------------
+ -- Set_End_Of_Line --
+ ---------------------
+
+ procedure Set_End_Of_Line (To : Project_Node_Id) is
+ begin
+ End_Of_Line_Node := To;
+ end Set_End_Of_Line;
+
----------------------------
-- Set_Expression_Kind_Of --
----------------------------
procedure Set_Expression_Kind_Of
- (Node : Project_Node_Id;
- To : Variable_Kind)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Variable_Kind)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Literal_String
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Declaration
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Typed_Variable_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Expression
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
or else
- Project_Nodes.Table (Node).Kind = N_Term
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Term
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ In_Tree.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;
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Attribute_Reference));
+ In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
end Set_Expression_Kind_Of;
-----------------------
-----------------------
procedure Set_Expression_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
+ (In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Attribute_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
+ In_Tree.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;
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Variable_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_Expression_Of;
-------------------------------
-------------------------------
procedure Set_External_Reference_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_External_Value);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_External_Reference_Of;
-----------------------------
-----------------------------
procedure Set_External_Default_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_External_Value);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_External_Default_Of;
----------------------------
----------------------------
procedure Set_First_Case_Item_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Construction);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_First_Case_Item_Of;
-------------------------
-------------------------
procedure Set_First_Choice_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Item);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_First_Choice_Of;
+ -----------------------------
+ -- Set_First_Comment_After --
+ -----------------------------
+
+ procedure Set_First_Comment_After
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+ is
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
+ begin
+ In_Tree.Project_Nodes.Table (Zone).Field2 := To;
+ end Set_First_Comment_After;
+
+ ---------------------------------
+ -- Set_First_Comment_After_End --
+ ---------------------------------
+
+ procedure Set_First_Comment_After_End
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+ is
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
+ begin
+ In_Tree.Project_Nodes.Table (Zone).Comments := To;
+ end Set_First_Comment_After_End;
+
+ ------------------------------
+ -- Set_First_Comment_Before --
+ ------------------------------
+
+ procedure Set_First_Comment_Before
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+
+ is
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
+ begin
+ In_Tree.Project_Nodes.Table (Zone).Field1 := To;
+ end Set_First_Comment_Before;
+
+ ----------------------------------
+ -- Set_First_Comment_Before_End --
+ ----------------------------------
+
+ procedure Set_First_Comment_Before_End
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+ is
+ Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
+ begin
+ In_Tree.Project_Nodes.Table (Zone).Field2 := To;
+ end Set_First_Comment_Before_End;
+
------------------------
-- Set_Next_Case_Item --
------------------------
procedure Set_Next_Case_Item
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Case_Item);
- Project_Nodes.Table (Node).Field3 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
end Set_Next_Case_Item;
+ ----------------------
+ -- Set_Next_Comment --
+ ----------------------
+
+ procedure Set_Next_Comment
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
+ In_Tree.Project_Nodes.Table (Node).Comments := To;
+ end Set_Next_Comment;
+
-----------------------------------
-- Set_First_Declarative_Item_Of --
-----------------------------------
procedure Set_First_Declarative_Item_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Project_Declaration
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
- Project_Nodes.Table (Node).Kind = N_Case_Item
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
or else
- Project_Nodes.Table (Node).Kind = N_Package_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
- if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
- Project_Nodes.Table (Node).Field1 := To;
+ if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
else
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end if;
end Set_First_Declarative_Item_Of;
----------------------------------
procedure Set_First_Expression_In_List
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Literal_String_List);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_First_Expression_In_List;
------------------------------
------------------------------
procedure Set_First_Literal_String
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_String_Type_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_First_Literal_String;
--------------------------
--------------------------
procedure Set_First_Package_Of
- (Node : Project_Node_Id;
- To : Package_Declaration_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Package_Declaration_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- Project_Nodes.Table (Node).Packages := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Packages := To;
end Set_First_Package_Of;
------------------------------
------------------------------
procedure Set_First_String_Type_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- Project_Nodes.Table (Node).Field3 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
end Set_First_String_Type_Of;
--------------------
--------------------
procedure Set_First_Term
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Expression);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_First_Term;
---------------------------
---------------------------
procedure Set_First_Variable_Of
- (Node : Project_Node_Id;
- To : Variable_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Variable_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Project
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
- Project_Nodes.Table (Node).Kind = N_Package_Declaration));
- Project_Nodes.Table (Node).Variables := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Variables := To;
end Set_First_Variable_Of;
------------------------------
------------------------------
procedure Set_First_With_Clause_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_First_With_Clause_Of;
+ --------------------------
+ -- Set_Is_Extending_All --
+ --------------------------
+
+ procedure Set_Is_Extending_All
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
+ In_Tree.Project_Nodes.Table (Node).Flag2 := True;
+ end Set_Is_Extending_All;
+
+ -----------------------------
+ -- Set_Is_Not_Last_In_List --
+ -----------------------------
+
+ procedure Set_Is_Not_Last_In_List
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
+ In_Tree.Project_Nodes.Table (Node).Flag1 := True;
+ end Set_Is_Not_Last_In_List;
+
-----------------
-- Set_Kind_Of --
-----------------
procedure Set_Kind_Of
- (Node : Project_Node_Id;
- To : Project_Node_Kind)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Kind)
is
begin
- pragma Assert (Node /= Empty_Node);
- Project_Nodes.Table (Node).Kind := To;
+ pragma Assert (Present (Node));
+ In_Tree.Project_Nodes.Table (Node).Kind := To;
end Set_Kind_Of;
---------------------
---------------------
procedure Set_Location_Of
- (Node : Project_Node_Id;
- To : Source_Ptr)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Source_Ptr)
is
begin
- pragma Assert (Node /= Empty_Node);
- Project_Nodes.Table (Node).Location := To;
+ pragma Assert (Present (Node));
+ In_Tree.Project_Nodes.Table (Node).Location := To;
end Set_Location_Of;
-----------------------------
- -- Set_Modified_Project_Of --
+ -- Set_Extended_Project_Of --
-----------------------------
- procedure Set_Modified_Project_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ procedure Set_Extended_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project_Declaration);
- Project_Nodes.Table (Node).Field2 := To;
- end Set_Modified_Project_Of;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
+ end Set_Extended_Project_Of;
----------------------------------
- -- Set_Modified_Project_Path_Of --
+ -- Set_Extended_Project_Path_Of --
----------------------------------
- procedure Set_Modified_Project_Path_Of
- (Node : Project_Node_Id;
- To : String_Id)
+ procedure Set_Extended_Project_Path_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Path_Name_Type)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
+ end Set_Extended_Project_Path_Of;
+
+ ------------------------------
+ -- Set_Extending_Project_Of --
+ ------------------------------
+
+ procedure Set_Extending_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- Project_Nodes.Table (Node).Value := To;
- end Set_Modified_Project_Path_Of;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
+ end Set_Extending_Project_Of;
-----------------
-- Set_Name_Of --
-----------------
procedure Set_Name_Of
- (Node : Project_Node_Id;
- To : Name_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Name_Id)
is
begin
- pragma Assert (Node /= Empty_Node);
- Project_Nodes.Table (Node).Name := To;
+ pragma Assert (Present (Node));
+ In_Tree.Project_Nodes.Table (Node).Name := To;
end Set_Name_Of;
-------------------------------
-------------------------------
procedure Set_Next_Declarative_Item
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Declarative_Item);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Next_Declarative_Item;
+ -----------------------
+ -- Set_Next_End_Node --
+ -----------------------
+
+ procedure Set_Next_End_Node (To : Project_Node_Id) is
+ begin
+ Next_End_Nodes.Increment_Last;
+ Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
+ end Set_Next_End_Node;
+
---------------------------------
-- Set_Next_Expression_In_List --
---------------------------------
procedure Set_Next_Expression_In_List
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Expression);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Next_Expression_In_List;
-----------------------------
-----------------------------
procedure Set_Next_Literal_String
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Literal_String);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_Next_Literal_String;
---------------------------------
---------------------------------
procedure Set_Next_Package_In_Project
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Package_Declaration);
- Project_Nodes.Table (Node).Field3 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
end Set_Next_Package_In_Project;
--------------------------
--------------------------
procedure Set_Next_String_Type
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_String_Type_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Next_String_Type;
-------------------
-------------------
procedure Set_Next_Term
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Term);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Next_Term;
-----------------------
-----------------------
procedure Set_Next_Variable
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
+ (In_Tree.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;
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Variable_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
end Set_Next_Variable;
-----------------------------
-----------------------------
procedure Set_Next_With_Clause_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_With_Clause);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Next_With_Clause_Of;
-----------------------
-----------------------
procedure Set_Package_Id_Of
- (Node : Project_Node_Id;
- To : Package_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Package_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Package_Declaration);
- Project_Nodes.Table (Node).Pkg_Id := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
end Set_Package_Id_Of;
-------------------------
-------------------------
procedure Set_Package_Node_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Package_Node_Of;
----------------------
----------------------
procedure Set_Path_Name_Of
- (Node : Project_Node_Id;
- To : Name_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Path_Name_Type)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Project
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
- Project_Nodes.Table (Node).Kind = N_With_Clause));
- Project_Nodes.Table (Node).Path_Name := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
+ In_Tree.Project_Nodes.Table (Node).Path_Name := To;
end Set_Path_Name_Of;
+ ---------------------------
+ -- Set_Previous_End_Node --
+ ---------------------------
+ procedure Set_Previous_End_Node (To : Project_Node_Id) is
+ begin
+ Previous_End_Node := To;
+ end Set_Previous_End_Node;
+
+ ----------------------------
+ -- Set_Previous_Line_Node --
+ ----------------------------
+
+ procedure Set_Previous_Line_Node (To : Project_Node_Id) is
+ begin
+ Previous_Line_Node := To;
+ end Set_Previous_Line_Node;
+
--------------------------------
-- Set_Project_Declaration_Of --
--------------------------------
procedure Set_Project_Declaration_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Project);
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end Set_Project_Declaration_Of;
+ ------------------------------
+ -- Set_Project_Qualifier_Of --
+ ------------------------------
+
+ procedure Set_Project_Qualifier_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Qualifier)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Qualifier := To;
+ end Set_Project_Qualifier_Of;
+
+ ---------------------------
+ -- Set_Parent_Project_Of --
+ ---------------------------
+
+ procedure Set_Parent_Project_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
+ In_Tree.Project_Nodes.Table (Node).Field4 := To;
+ end Set_Parent_Project_Of;
+
+ -----------------------------------------------
+ -- Set_Project_File_Includes_Unkept_Comments --
+ -----------------------------------------------
+
+ procedure Set_Project_File_Includes_Unkept_Comments
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Boolean)
+ is
+ Declaration : constant Project_Node_Id :=
+ Project_Declaration_Of (Node, In_Tree);
+ begin
+ In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
+ end Set_Project_File_Includes_Unkept_Comments;
+
-------------------------
-- Set_Project_Node_Of --
-------------------------
procedure Set_Project_Node_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id;
+ Limited_With : Boolean := False)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_With_Clause
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
- Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
- Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
+
+ if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
+ and then not Limited_With
+ then
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
+ end if;
end Set_Project_Node_Of;
---------------------------------------
---------------------------------------
procedure Set_Project_Of_Renamed_Package_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- Project_Nodes.Table (Node).Kind = N_Package_Declaration);
- Project_Nodes.Table (Node).Field1 := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
+ In_Tree.Project_Nodes.Table (Node).Field1 := To;
end Set_Project_Of_Renamed_Package_Of;
+ -------------------------
+ -- Set_Source_Index_Of --
+ -------------------------
+
+ procedure Set_Source_Index_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Int)
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Attribute_Declaration));
+ In_Tree.Project_Nodes.Table (Node).Src_Index := To;
+ end Set_Source_Index_Of;
+
------------------------
-- Set_String_Type_Of --
------------------------
procedure Set_String_Type_Of
- (Node : Project_Node_Id;
- To : Project_Node_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Project_Node_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ (In_Tree.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);
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Typed_Variable_Declaration)
+ and then
+ In_Tree.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;
+ if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
+ In_Tree.Project_Nodes.Table (Node).Field3 := To;
else
- Project_Nodes.Table (Node).Field2 := To;
+ In_Tree.Project_Nodes.Table (Node).Field2 := To;
end if;
end Set_String_Type_Of;
-------------------------
procedure Set_String_Value_Of
- (Node : Project_Node_Id;
- To : String_Id)
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref;
+ To : Name_Id)
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_With_Clause
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
or else
- Project_Nodes.Table (Node).Kind = N_Literal_String));
- Project_Nodes.Table (Node).Value := To;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
+ In_Tree.Project_Nodes.Table (Node).Value := To;
end Set_String_Value_Of;
+ ---------------------
+ -- Source_Index_Of --
+ ---------------------
+
+ function Source_Index_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Int
+ is
+ begin
+ pragma Assert
+ (Present (Node)
+ and then
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Attribute_Declaration));
+ return In_Tree.Project_Nodes.Table (Node).Src_Index;
+ end Source_Index_Of;
+
--------------------
-- String_Type_Of --
--------------------
- function String_Type_Of (Node : Project_Node_Id)
- return Project_Node_Id is
+ function String_Type_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_Variable_Reference
+ (In_Tree.Project_Nodes.Table (Node).Kind =
+ N_Variable_Reference
or else
- Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration));
+ In_Tree.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;
+ if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
+ return In_Tree.Project_Nodes.Table (Node).Field3;
else
- return Project_Nodes.Table (Node).Field2;
+ return In_Tree.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
+ function String_Value_Of
+ (Node : Project_Node_Id;
+ In_Tree : Project_Node_Tree_Ref) return Name_Id
+ is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
- (Project_Nodes.Table (Node).Kind = N_With_Clause
+ (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
- Project_Nodes.Table (Node).Kind = N_Literal_String));
- return Project_Nodes.Table (Node).Value;
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
+ or else
+ In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
+ return In_Tree.Project_Nodes.Table (Node).Value;
end String_Value_Of;
--------------------
function Value_Is_Valid
(For_Typed_Variable : Project_Node_Id;
- Value : String_Id)
- return Boolean
+ In_Tree : Project_Node_Tree_Ref;
+ Value : Name_Id) return Boolean
is
begin
pragma Assert
- (For_Typed_Variable /= Empty_Node
+ (Present (For_Typed_Variable)
and then
- (Project_Nodes.Table (For_Typed_Variable).Kind =
+ (In_Tree.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));
+ (String_Type_Of (For_Typed_Variable, In_Tree),
+ In_Tree);
begin
- while Current_String /= Empty_Node
+ while Present (Current_String)
and then
- not String_Equal (String_Value_Of (Current_String), Value)
+ String_Value_Of (Current_String, In_Tree) /= Value
loop
Current_String :=
- Next_Literal_String (Current_String);
+ Next_Literal_String (Current_String, In_Tree);
end loop;
- return Current_String /= Empty_Node;
+ return Present (Current_String);
end;
end Value_Is_Valid;
+ -------------------------------
+ -- There_Are_Unkept_Comments --
+ -------------------------------
+
+ function There_Are_Unkept_Comments return Boolean is
+ begin
+ return Unkept_Comments;
+ end There_Are_Unkept_Comments;
+
+ --------------------
+ -- Create_Project --
+ --------------------
+
+ function Create_Project
+ (In_Tree : Project_Node_Tree_Ref;
+ Name : Name_Id;
+ Full_Path : Path_Name_Type;
+ Is_Config_File : Boolean := False) return Project_Node_Id
+ is
+ Project : Project_Node_Id;
+ Qualifier : Project_Qualifier := Unspecified;
+ begin
+ Project := Default_Project_Node (In_Tree, N_Project);
+ Set_Name_Of (Project, In_Tree, Name);
+ Set_Directory_Of
+ (Project, In_Tree,
+ Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
+ Set_Path_Name_Of (Project, In_Tree, Full_Path);
+
+ Set_Project_Declaration_Of
+ (Project, In_Tree,
+ Default_Project_Node (In_Tree, N_Project_Declaration));
+
+ if Is_Config_File then
+ Qualifier := Configuration;
+ end if;
+
+ if not Is_Config_File then
+ Prj.Tree.Tree_Private_Part.Projects_Htable.Set
+ (In_Tree.Projects_HT,
+ Name,
+ Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
+ (Name => Name,
+ Display_Name => Name,
+ Canonical_Path => No_Path,
+ Node => Project,
+ Extended => False,
+ Proj_Qualifier => Qualifier));
+ end if;
+
+ return Project;
+ end Create_Project;
+
+ ----------------
+ -- Add_At_End --
+ ----------------
+
+ procedure Add_At_End
+ (Tree : Project_Node_Tree_Ref;
+ Parent : Project_Node_Id;
+ Expr : Project_Node_Id;
+ Add_Before_First_Pkg : Boolean := False;
+ Add_Before_First_Case : Boolean := False)
+ is
+ Real_Parent : Project_Node_Id;
+ New_Decl, Decl, Next : Project_Node_Id;
+ Last, L : Project_Node_Id;
+
+ begin
+ if Kind_Of (Expr, Tree) /= N_Declarative_Item then
+ New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
+ Set_Current_Item_Node (New_Decl, Tree, Expr);
+ else
+ New_Decl := Expr;
+ end if;
+
+ if Kind_Of (Parent, Tree) = N_Project then
+ Real_Parent := Project_Declaration_Of (Parent, Tree);
+ else
+ Real_Parent := Parent;
+ end if;
+
+ Decl := First_Declarative_Item_Of (Real_Parent, Tree);
+
+ if Decl = Empty_Node then
+ Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
+ else
+ loop
+ Next := Next_Declarative_Item (Decl, Tree);
+ exit when Next = Empty_Node
+ or else
+ (Add_Before_First_Pkg
+ and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
+ N_Package_Declaration)
+ or else
+ (Add_Before_First_Case
+ and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
+ N_Case_Construction);
+ Decl := Next;
+ end loop;
+
+ -- In case Expr is in fact a range of declarative items
+
+ Last := New_Decl;
+ loop
+ L := Next_Declarative_Item (Last, Tree);
+ exit when L = Empty_Node;
+ Last := L;
+ end loop;
+
+ -- In case Expr is in fact a range of declarative items
+
+ Last := New_Decl;
+ loop
+ L := Next_Declarative_Item (Last, Tree);
+ exit when L = Empty_Node;
+ Last := L;
+ end loop;
+
+ Set_Next_Declarative_Item (Last, Tree, Next);
+ Set_Next_Declarative_Item (Decl, Tree, New_Decl);
+ end if;
+ end Add_At_End;
+
+ ---------------------------
+ -- Create_Literal_String --
+ ---------------------------
+
+ function Create_Literal_String
+ (Str : Namet.Name_Id;
+ Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ Node : Project_Node_Id;
+ begin
+ Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
+ Set_Next_Literal_String (Node, Tree, Empty_Node);
+ Set_String_Value_Of (Node, Tree, Str);
+ return Node;
+ end Create_Literal_String;
+
+ ---------------------------
+ -- Enclose_In_Expression --
+ ---------------------------
+
+ function Enclose_In_Expression
+ (Node : Project_Node_Id;
+ Tree : Project_Node_Tree_Ref) return Project_Node_Id
+ is
+ Expr : Project_Node_Id;
+ begin
+ if Kind_Of (Node, Tree) /= N_Expression then
+ Expr := Default_Project_Node (Tree, N_Expression, Single);
+ Set_First_Term
+ (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
+ Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
+ return Expr;
+ else
+ return Node;
+ end if;
+ end Enclose_In_Expression;
+
+ --------------------
+ -- Create_Package --
+ --------------------
+
+ function Create_Package
+ (Tree : Project_Node_Tree_Ref;
+ Project : Project_Node_Id;
+ Pkg : String) return Project_Node_Id
+ is
+ Pack : Project_Node_Id;
+ N : Name_Id;
+
+ begin
+ Name_Len := Pkg'Length;
+ Name_Buffer (1 .. Name_Len) := Pkg;
+ N := Name_Find;
+
+ -- Check if the package already exists
+
+ Pack := First_Package_Of (Project, Tree);
+ while Pack /= Empty_Node loop
+ if Prj.Tree.Name_Of (Pack, Tree) = N then
+ return Pack;
+ end if;
+
+ Pack := Next_Package_In_Project (Pack, Tree);
+ end loop;
+
+ -- Create the package and add it to the declarative item
+
+ Pack := Default_Project_Node (Tree, N_Package_Declaration);
+ Set_Name_Of (Pack, Tree, N);
+
+ -- Find the correct package id to use
+
+ Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
+
+ -- Add it to the list of packages
+
+ Set_Next_Package_In_Project
+ (Pack, Tree, First_Package_Of (Project, Tree));
+ Set_First_Package_Of (Project, Tree, Pack);
+
+ Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
+
+ return Pack;
+ end Create_Package;
+
+ ----------------------
+ -- Create_Attribute --
+ ----------------------
+
+ function Create_Attribute
+ (Tree : Project_Node_Tree_Ref;
+ Prj_Or_Pkg : Project_Node_Id;
+ Name : Name_Id;
+ Index_Name : Name_Id := No_Name;
+ Kind : Variable_Kind := List;
+ At_Index : Integer := 0;
+ Value : Project_Node_Id := Empty_Node) return Project_Node_Id
+ is
+ Node : constant Project_Node_Id :=
+ Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
+
+ Case_Insensitive : Boolean;
+
+ Pkg : Package_Node_Id;
+ Start_At : Attribute_Node_Id;
+ Expr : Project_Node_Id;
+
+ begin
+ Set_Name_Of (Node, Tree, Name);
+
+ if Index_Name /= No_Name then
+ Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
+ end if;
+
+ if Prj_Or_Pkg /= Empty_Node then
+ Add_At_End (Tree, Prj_Or_Pkg, Node);
+ end if;
+
+ -- Find out the case sensitivity of the attribute
+
+ if Prj_Or_Pkg /= Empty_Node
+ and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
+ then
+ Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
+ Start_At := First_Attribute_Of (Pkg);
+ else
+ Start_At := Attribute_First;
+ end if;
+
+ Start_At := Attribute_Node_Id_Of (Name, Start_At);
+ Case_Insensitive :=
+ Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
+ Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
+
+ if At_Index /= 0 then
+ if Attribute_Kind_Of (Start_At) =
+ Optional_Index_Associative_Array
+ or else Attribute_Kind_Of (Start_At) =
+ Optional_Index_Case_Insensitive_Associative_Array
+ then
+ -- Results in: for Name ("index" at index) use "value";
+ -- This is currently only used for executables.
+
+ Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
+
+ else
+ -- Results in: for Name ("index") use "value" at index;
+
+ -- ??? This limitation makes no sense, we should be able to
+ -- set the source index on an expression.
+
+ pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
+ Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
+ end if;
+ end if;
+
+ if Value /= Empty_Node then
+ Expr := Enclose_In_Expression (Value, Tree);
+ Set_Expression_Of (Node, Tree, Expr);
+ end if;
+
+ return Node;
+ end Create_Attribute;
+
end Prj.Tree;
OSDN Git Service
