-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2007, 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, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, 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. --
-- 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 :=
begin
pragma Assert
- (To /= Empty_Node
- and then
- In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
+ (Present (To)
+ and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
Zone := In_Tree.Project_Nodes.Table (To).Comments;
- if Zone = Empty_Node then
+ 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,
- 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,
- Flag1 => False,
- Flag2 => False,
- Comments => Empty_Node);
+ (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;
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 =>
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 Previous = Empty_Node then
+ if No (Previous) then
case Where is
when Before =>
In_Tree.Project_Nodes.Table (Zone).Field1 :=
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return In_Tree.Project_Nodes.Table (Node).Field2;
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
return In_Tree.Project_Nodes.Table (Node).Field1;
Zone : Project_Node_Id;
begin
- pragma Assert (Node /= Empty_Node);
+ 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 Zone = Empty_Node then
+ 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,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
return In_Tree.Project_Nodes.Table (Node).Field1;
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,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
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,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
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 =>
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 Previous = Empty_Node then
+ if No (Previous) then
In_Tree.Project_Nodes.Table (Zone).Field1 :=
Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Directory;
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return No_Name;
else
return In_Tree.Project_Nodes.Table (Zone).Value;
In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Packages;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field1;
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Flag1;
begin
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;
+ ----------
+ -- 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);
+ Name_To_Name_HTable.Reset (Proj.External_References);
+ Free (Proj.Project_Path);
+ Unchecked_Free (Proj);
+ end if;
+ end Free;
+
-------------------------------
-- Is_Followed_By_Empty_Line --
-------------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Flag2;
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
return In_Tree.Project_Nodes.Table (Node).Flag1;
begin
-- First check all the imported projects
- while With_Clause /= Empty_Node loop
+ 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 Result /= Empty_Node
+ 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 the imported project
+ -- If it is not an imported project, it might be an extended project
- if With_Clause = Empty_Node then
- Result :=
- Extended_Project_Of
- (Project_Declaration_Of (Project, In_Tree), In_Tree);
+ if No (With_Clause) then
+ Result := Project;
+ loop
+ Result :=
+ Extended_Project_Of
+ (Project_Declaration_Of (Result, In_Tree), In_Tree);
- if Result /= Empty_Node
- and then Name_Of (Result, In_Tree) /= With_Name
- then
- Result := Empty_Node;
- end if;
+ exit when No (Result)
+ or else Name_Of (Result, In_Tree) = With_Name;
+ end loop;
end if;
return Result;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Kind;
end Kind_Of;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Location;
end Location_Of;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Name;
end Name_Of;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
return In_Tree.Project_Nodes.Table (Node).Field3;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Comments;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Typed_Variable_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (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 --
---------------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
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 --
----------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (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 --
-------------------------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field1;
Comments.Set_Last (0);
end Reset_State;
- -------------
- -- Restore --
- -------------
+ ----------------------
+ -- 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);
- procedure Restore (S : Comment_State) is
begin
End_Of_Line_Node := S.End_Of_Line_Node;
Previous_Line_Node := S.Previous_Line_Node;
Comments.Increment_Last;
Comments.Table (Comments.Last) := S.Comments (J);
end loop;
- end Restore;
+
+ Unchecked_Free (S.Comments);
+ end Restore_And_Free;
----------
-- Save --
-- an end of line node specified, associate the comment with
-- this node.
- elsif End_Of_Line_Node /= Empty_Node then
+ elsif Present (End_Of_Line_Node) then
declare
Zones : constant Project_Node_Id :=
Comment_Zones_Of (End_Of_Line_Node, In_Tree);
if Comments.Last > 0 and then
not Comments.Table (1).Follows_Empty_Line then
- if Previous_Line_Node /= Empty_Node then
+ if Present (Previous_Line_Node) then
Add_Comments
(To => Previous_Line_Node,
Where => After,
In_Tree => In_Tree);
- elsif Previous_End_Node /= Empty_Node then
+ elsif Present (Previous_End_Node) then
Add_Comments
(To => Previous_End_Node,
Where => After_End,
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration));
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Directory := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
In_Tree.Project_Nodes.Table (Node).Comments := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Packages := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
In_Tree.Project_Nodes.Table (Node).Flag1 := True;
To : Project_Node_Kind)
is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Kind := To;
end Set_Kind_Of;
To : Source_Ptr)
is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Location := To;
end Set_Location_Of;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
To : Name_Id)
is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Name := To;
end Set_Name_Of;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Typed_Variable_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (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 --
-----------------------------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Variable_Reference
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Variable_Reference
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (For_Typed_Variable /= Empty_Node
+ (Present (For_Typed_Variable)
and then
(In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
N_Typed_Variable_Declaration));
In_Tree);
begin
- while Current_String /= Empty_Node
+ while Present (Current_String)
and then
String_Value_Of (Current_String, In_Tree) /= Value
loop
Next_Literal_String (Current_String, In_Tree);
end loop;
- return Current_String /= Empty_Node;
+ return Present (Current_String);
end;
end Value_Is_Valid;
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
