diff options
Diffstat (limited to 'gcc-4.9/gcc/ada/prj-tree.adb')
| -rw-r--r-- | gcc-4.9/gcc/ada/prj-tree.adb | 3170 |
1 files changed, 3170 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/prj-tree.adb b/gcc-4.9/gcc/ada/prj-tree.adb new file mode 100644 index 000000000..37ec38fe7 --- /dev/null +++ b/gcc-4.9/gcc/ada/prj-tree.adb @@ -0,0 +1,3170 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- P R J . T R E E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2001-2013, 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 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 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. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +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; + In_Tree : Project_Node_Tree_Ref) return Name_Id + 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).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; + 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_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; + 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_Declarative_Item); + return In_Tree.Project_Nodes.Table (Node).Field1; + end Current_Item_Node; + + ------------------ + -- Current_Term -- + ------------------ + + function Current_Term + (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_Term); + return In_Tree.Project_Nodes.Table (Node).Field1; + end Current_Term; + + -------------------------- + -- Default_Project_Node -- + -------------------------- + + function Default_Project_Node + (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; + 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 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; + In_Tree : Project_Node_Tree_Ref) return Variable_Kind + is + begin + pragma Assert + (Present (Node) + and then -- should use Nkind_In here ??? why not??? + (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Term + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value)); + return In_Tree.Project_Nodes.Table (Node).Expr_Kind; + end Expression_Kind_Of; + + ------------------- + -- Expression_Of -- + ------------------- + + function Expression_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 + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); + + 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; + 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_External_Value); + return In_Tree.Project_Nodes.Table (Node).Field1; + end External_Reference_Of; + + ------------------------- + -- External_Default_Of -- + ------------------------- + + function External_Default_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_External_Value); + return In_Tree.Project_Nodes.Table (Node).Field2; + end External_Default_Of; + + ------------------------ + -- First_Case_Item_Of -- + ------------------------ + + function First_Case_Item_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_Case_Construction); + return In_Tree.Project_Nodes.Table (Node).Field2; + end First_Case_Item_Of; + + --------------------- + -- First_Choice_Of -- + --------------------- + + function First_Choice_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_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; + 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 + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); + + if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then + return In_Tree.Project_Nodes.Table (Node).Field1; + else + return In_Tree.Project_Nodes.Table (Node).Field2; + end if; + end First_Declarative_Item_Of; + + ------------------------------ + -- First_Expression_In_List -- + ------------------------------ + + function First_Expression_In_List + (Node : Project_Node_Id; + 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_Literal_String_List); + return In_Tree.Project_Nodes.Table (Node).Field1; + end First_Expression_In_List; + + -------------------------- + -- First_Literal_String -- + -------------------------- + + function First_Literal_String + (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_String_Type_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field1; + end First_Literal_String; + + ---------------------- + -- First_Package_Of -- + ---------------------- + + function First_Package_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Package_Declaration_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).Packages; + end First_Package_Of; + + -------------------------- + -- First_String_Type_Of -- + -------------------------- + + function First_String_Type_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).Field3; + end First_String_Type_Of; + + ---------------- + -- First_Term -- + ---------------- + + function First_Term + (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_Expression); + return In_Tree.Project_Nodes.Table (Node).Field1; + end First_Term; + + ----------------------- + -- First_Variable_Of -- + ----------------------- + + function First_Variable_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id + 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_Package_Declaration)); + + return In_Tree.Project_Nodes.Table (Node).Variables; + end First_Variable_Of; + + -------------------------- + -- First_With_Clause_Of -- + -------------------------- + + function First_With_Clause_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).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 (Tree : Project_Node_Tree_Ref) is + begin + Project_Node_Table.Init (Tree.Project_Nodes); + Projects_Htable.Reset (Tree.Projects_HT); + end Initialize; + + -------------------- + -- Override_Flags -- + -------------------- + + procedure Override_Flags + (Self : in out Environment; + Flags : Prj.Processing_Flags) + is + begin + Self.Flags := Flags; + end Override_Flags; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize + (Self : out Environment; + Flags : Processing_Flags) + is + begin + -- Do not reset the external references, in case we are reloading a + -- project, since we want to preserve the current environment. But we + -- still need to ensure that the external references are properly + -- initialized. + + Prj.Ext.Initialize (Self.External); + + Self.Flags := Flags; + end Initialize; + + ------------------------- + -- Initialize_And_Copy -- + ------------------------- + + procedure Initialize_And_Copy + (Self : out Environment; + Copy_From : Environment) + is + begin + Self.Flags := Copy_From.Flags; + Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External); + Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path); + end Initialize_And_Copy; + + ---------- + -- Free -- + ---------- + + procedure Free (Self : in out Environment) is + begin + Prj.Ext.Free (Self.External); + Free (Self.Project_Path); + end Free; + + ---------- + -- Free -- + ---------- + + 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 + if Proj /= null then + Project_Node_Table.Free (Proj.Project_Nodes); + Projects_Htable.Reset (Proj.Projects_HT); + Unchecked_Free (Proj); + end if; + end Free; + + ------------------------------- + -- Is_Followed_By_Empty_Line -- + ------------------------------- + + function Is_Followed_By_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).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; + + ------------------------- + -- Is_Not_Last_In_List -- + ------------------------- + + function Is_Not_Last_In_List + (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_With_Clause); + return In_Tree.Project_Nodes.Table (Node).Flag1; + end Is_Not_Last_In_List; + + ------------------------------------- + -- Imported_Or_Extended_Project_Of -- + ------------------------------------- + + 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 + -- 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; + In_Tree : Project_Node_Tree_Ref) return Name_Id + is + begin + pragma Assert (Present (Node)); + return In_Tree.Project_Nodes.Table (Node).Name; + end Name_Of; + + -------------------- + -- Next_Case_Item -- + -------------------- + + function Next_Case_Item + (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_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; + 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_Declarative_Item); + return In_Tree.Project_Nodes.Table (Node).Field2; + end Next_Declarative_Item; + + ----------------------------- + -- Next_Expression_In_List -- + ----------------------------- + + function Next_Expression_In_List + (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_Expression); + return In_Tree.Project_Nodes.Table (Node).Field2; + end Next_Expression_In_List; + + ------------------------- + -- Next_Literal_String -- + ------------------------- + + function Next_Literal_String + (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_Literal_String); + return In_Tree.Project_Nodes.Table (Node).Field1; + end Next_Literal_String; + + ----------------------------- + -- Next_Package_In_Project -- + ----------------------------- + + function Next_Package_In_Project + (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_Package_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field3; + end Next_Package_In_Project; + + ---------------------- + -- Next_String_Type -- + ---------------------- + + function Next_String_Type + (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_String_Type_Declaration); + return In_Tree.Project_Nodes.Table (Node).Field2; + end Next_String_Type; + + --------------- + -- Next_Term -- + --------------- + + function Next_Term + (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_Term); + return In_Tree.Project_Nodes.Table (Node).Field2; + end Next_Term; + + ------------------- + -- Next_Variable -- + ------------------- + + function Next_Variable + (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_Typed_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); + + return In_Tree.Project_Nodes.Table (Node).Field3; + end Next_Variable; + + ------------------------- + -- Next_With_Clause_Of -- + ------------------------- + + function Next_With_Clause_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).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; + In_Tree : Project_Node_Tree_Ref) return Package_Node_Id + is + begin + pragma Assert + (Present (Node) + and then + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + return In_Tree.Project_Nodes.Table (Node).Pkg_Id; + end Package_Id_Of; + + --------------------- + -- Package_Node_Of -- + --------------------- + + function Package_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_Variable_Reference + or else + 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; + 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 + or else + 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; + 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).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; + 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 + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + return In_Tree.Project_Nodes.Table (Node).Field1; + end Project_Node_Of; + + ----------------------------------- + -- Project_Of_Renamed_Package_Of -- + ----------------------------------- + + function Project_Of_Renamed_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_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; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) + 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).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; + 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_Case_Construction); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_Case_Variable_Reference_Of; + + --------------------------- + -- Set_Current_Item_Node -- + --------------------------- + + procedure Set_Current_Item_Node + (Node : Project_Node_Id; + 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_Declarative_Item); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_Current_Item_Node; + + ---------------------- + -- Set_Current_Term -- + ---------------------- + + procedure Set_Current_Term + (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_Term); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_Current_Term; + + ---------------------- + -- Set_Directory_Of -- + ---------------------- + + procedure Set_Directory_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).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; + In_Tree : Project_Node_Tree_Ref; + To : Variable_Kind) + is + begin + pragma Assert + (Present (Node) + and then -- should use Nkind_In here ??? why not??? + (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Expression + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Term + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value)); + In_Tree.Project_Nodes.Table (Node).Expr_Kind := To; + end Set_Expression_Kind_Of; + + ----------------------- + -- Set_Expression_Of -- + ----------------------- + + procedure Set_Expression_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 + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_Expression_Of; + + ------------------------------- + -- Set_External_Reference_Of -- + ------------------------------- + + procedure Set_External_Reference_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_External_Value); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_External_Reference_Of; + + ----------------------------- + -- Set_External_Default_Of -- + ----------------------------- + + procedure Set_External_Default_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_External_Value); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_External_Default_Of; + + ---------------------------- + -- Set_First_Case_Item_Of -- + ---------------------------- + + procedure Set_First_Case_Item_Of + (Node : Project_Node_Id; + 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_Case_Construction); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_First_Case_Item_Of; + + ------------------------- + -- Set_First_Choice_Of -- + ------------------------- + + procedure Set_First_Choice_Of + (Node : Project_Node_Id; + 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_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; + 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_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; + 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_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); + + if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then + In_Tree.Project_Nodes.Table (Node).Field1 := To; + else + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end if; + end Set_First_Declarative_Item_Of; + + ---------------------------------- + -- Set_First_Expression_In_List -- + ---------------------------------- + + procedure Set_First_Expression_In_List + (Node : Project_Node_Id; + 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_Literal_String_List); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_First_Expression_In_List; + + ------------------------------ + -- Set_First_Literal_String -- + ------------------------------ + + procedure Set_First_Literal_String + (Node : Project_Node_Id; + 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_String_Type_Declaration); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_First_Literal_String; + + -------------------------- + -- Set_First_Package_Of -- + -------------------------- + + procedure Set_First_Package_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Package_Declaration_Id) + is + begin + pragma Assert + (Present (Node) + and then + In_Tree.Project_Nodes.Table (Node).Kind = N_Project); + In_Tree.Project_Nodes.Table (Node).Packages := To; + end Set_First_Package_Of; + + ------------------------------ + -- Set_First_String_Type_Of -- + ------------------------------ + + procedure Set_First_String_Type_Of + (Node : Project_Node_Id; + 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).Field3 := To; + end Set_First_String_Type_Of; + + -------------------- + -- Set_First_Term -- + -------------------- + + procedure Set_First_Term + (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_Expression); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_First_Term; + + --------------------------- + -- Set_First_Variable_Of -- + --------------------------- + + procedure Set_First_Variable_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Variable_Node_Id) + 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_Package_Declaration)); + In_Tree.Project_Nodes.Table (Node).Variables := To; + end Set_First_Variable_Of; + + ------------------------------ + -- Set_First_With_Clause_Of -- + ------------------------------ + + procedure Set_First_With_Clause_Of + (Node : Project_Node_Id; + 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).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; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Kind) + is + begin + pragma Assert (Present (Node)); + In_Tree.Project_Nodes.Table (Node).Kind := To; + end Set_Kind_Of; + + --------------------- + -- Set_Location_Of -- + --------------------- + + procedure Set_Location_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Source_Ptr) + is + begin + pragma Assert (Present (Node)); + In_Tree.Project_Nodes.Table (Node).Location := To; + end Set_Location_Of; + + ----------------------------- + -- Set_Extended_Project_Of -- + ----------------------------- + + procedure Set_Extended_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_Declaration); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_Extended_Project_Of; + + ---------------------------------- + -- Set_Extended_Project_Path_Of -- + ---------------------------------- + + 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 + (Present (Node) + and then + 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; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) + is + begin + pragma Assert (Present (Node)); + In_Tree.Project_Nodes.Table (Node).Name := To; + end Set_Name_Of; + + ------------------------------- + -- Set_Next_Declarative_Item -- + ------------------------------- + + procedure Set_Next_Declarative_Item + (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_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; + 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_Expression); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_Next_Expression_In_List; + + ----------------------------- + -- Set_Next_Literal_String -- + ----------------------------- + + procedure Set_Next_Literal_String + (Node : Project_Node_Id; + 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_Literal_String); + In_Tree.Project_Nodes.Table (Node).Field1 := To; + end Set_Next_Literal_String; + + --------------------------------- + -- Set_Next_Package_In_Project -- + --------------------------------- + + procedure Set_Next_Package_In_Project + (Node : Project_Node_Id; + 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_Package_Declaration); + In_Tree.Project_Nodes.Table (Node).Field3 := To; + end Set_Next_Package_In_Project; + + -------------------------- + -- Set_Next_String_Type -- + -------------------------- + + procedure Set_Next_String_Type + (Node : Project_Node_Id; + 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_String_Type_Declaration); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_Next_String_Type; + + ------------------- + -- Set_Next_Term -- + ------------------- + + procedure Set_Next_Term + (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_Term); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_Next_Term; + + ----------------------- + -- Set_Next_Variable -- + ----------------------- + + procedure Set_Next_Variable + (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_Typed_Variable_Declaration + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Variable_Declaration)); + In_Tree.Project_Nodes.Table (Node).Field3 := To; + end Set_Next_Variable; + + ----------------------------- + -- Set_Next_With_Clause_Of -- + ----------------------------- + + procedure Set_Next_With_Clause_Of + (Node : Project_Node_Id; + 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_With_Clause); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_Next_With_Clause_Of; + + ----------------------- + -- Set_Package_Id_Of -- + ----------------------- + + procedure Set_Package_Id_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Package_Node_Id) + is + begin + pragma Assert + (Present (Node) + and then + In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); + In_Tree.Project_Nodes.Table (Node).Pkg_Id := To; + end Set_Package_Id_Of; + + ------------------------- + -- Set_Package_Node_Of -- + ------------------------- + + procedure Set_Package_Node_Of + (Node : Project_Node_Id; + 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_Variable_Reference + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end Set_Package_Node_Of; + + ---------------------- + -- Set_Path_Name_Of -- + ---------------------- + + procedure Set_Path_Name_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 + or else + 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; + 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).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; + In_Tree : Project_Node_Tree_Ref; + To : Project_Node_Id; + Limited_With : Boolean := False) + is + begin + pragma Assert + (Present (Node) + and then + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference + or else + 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; + + --------------------------------------- + -- Set_Project_Of_Renamed_Package_Of -- + --------------------------------------- + + procedure Set_Project_Of_Renamed_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_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; + 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_Variable_Reference + or else + 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 In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then + In_Tree.Project_Nodes.Table (Node).Field3 := To; + else + In_Tree.Project_Nodes.Table (Node).Field2 := To; + end if; + end Set_String_Type_Of; + + ------------------------- + -- Set_String_Value_Of -- + ------------------------- + + procedure Set_String_Value_Of + (Node : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + To : Name_Id) + is + begin + pragma Assert + (Present (Node) + and then + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause + or else + In_Tree.Project_Nodes.Table (Node).Kind = N_Comment + or else + 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; + 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_Variable_Reference + or else + In_Tree.Project_Nodes.Table (Node).Kind = + N_Typed_Variable_Declaration)); + + if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then + return In_Tree.Project_Nodes.Table (Node).Field3; + else + 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; + In_Tree : Project_Node_Tree_Ref) return Name_Id + is + begin + pragma Assert + (Present (Node) + and then + (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause + or else + 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; + + -------------------- + -- Value_Is_Valid -- + -------------------- + + function Value_Is_Valid + (For_Typed_Variable : Project_Node_Id; + In_Tree : Project_Node_Tree_Ref; + Value : Name_Id) return Boolean + is + begin + pragma Assert + (Present (For_Typed_Variable) + and then + (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, In_Tree), + In_Tree); + + begin + while Present (Current_String) + and then + String_Value_Of (Current_String, In_Tree) /= Value + loop + Current_String := + Next_Literal_String (Current_String, In_Tree); + end loop; + + 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, + Resolved_Path => No_Path, + Node => Project, + Extended => False, + From_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; |