Skip to content

R
riscv-gcc-1
Commit 4f469be3 by Vincent Celier Committed by Arnaud Charlet
Options

prj.adb (Hash (Project_Id)): New function 

2008-05-20  Vincent Celier  <celier@adacore.com>

	* prj.adb (Hash (Project_Id)): New function
	(Project_Empty): Add new component Interfaces_Defined

	* prj.ads (Source_Data): New component Object_Linked
	(Language_Config): New components Object_Generated and Objects_Linked
	(Hash (Project_Id)): New function
	(Source_Data): New Boolean components In_Interfaces and
	Declared_In_Interfaces.
	(Project_Data): New Boolean component Interfaces_Defined

	* prj-attr.adb: 
	New project level attribute Object_Generated and Objects_Linked
	Add new project level attribute Interfaces

	* prj-dect.adb: Use functions Present and No throughout
	(Parse_Variable_Declaration): If a string type is specified as a simple
	name and is not found in the current project, look for it also in the
	ancestors of the project.

	* prj-makr.adb: 
	Replace procedure Make with procedures Initialize, Process and Finalize
	to implement H414-023: process different directories with different
	patterns.
	Use functions Present and No throughout

	* prj-makr.ads: 
	Replace procedure Make with procedures Initialize, Process and Finalize

	* prj-nmsc.adb
	(Add_Source): Set component Object_Exists and Object_Linked accordnig to
	the language configuration.
	(Process_Project_Level_Array_Attributes): Process new attributes
	Object_Generated and Object_Linked.
	(Report_No_Sources): New Boolean parameter Continuation, defaulted to
	False, to indicate that the erreor/warning is a continuation.
	(Check): Call Report_No_Sources with Contnuation = True after the first
	call.
	(Error_Msg): Process successively contnuation character and warning
	character.
	(Find_Explicit_Sources): Check that all declared sources have been found
	(Check_File): Indicate in hash table Source_Names when a declared source
	is found.
	(Check_File): Set Other_Part when found
	(Find_Explicit_Sources): In multi language mode, check if all exceptions
	to the naming scheme have been found. For Ada, report an error if an
	exception has not been found. Otherwise, disregard the exception.
	(Check_Interfaces): New procedure
	(Add_Source): When Other_Part is defined, set mutual pointers in spec
	and body.
	(Check): In multi-language mode, call Check_Interfaces
	(Process_Sources_In_Multi_Language_Mode): Set In_Interfaces to False
	for an excluded source.
	(Remove_Source): A source replacing a source in the interfaces is also
	in the interfaces.

	* prj-pars.adb: Use function Present

	* prj-part.adb: Use functions Present and No throughout
	(Parse_Single_Project): Set the parent project for child projects
	(Create_Virtual_Extending_Project): Register project with no qualifier
	(Parse_Single_Project): Allow an abstract project to be extend several
	times. Do not allow an abstract project to extend a non abstract
	project.

	* prj-pp.adb: Use functions Present and No throughout
	(Print): Take into account the full associative array attribute
	declarations.

	* prj-proc.adb: Use functions Present and No throughout
	(Expression): Call itself with the same From_Project_Node for the
	default value of an external reference.

	* prj-strt.adb: Use functions Present and No throughout
	(Parse_Variable_Reference): If a variable is specified as a simple name
	and is not found in the current project, look for it also in the
	ancestors of the project.

	* prj-tree.ads, prj-tree.adb (Present): New function
	(No): New function
	Use functions Present and No throughout
	(Parent_Project_Of): New function
	(Set_Parent_Project_Of): New procedure

	* snames.ads, snames.adb: 
	Add new standard names Object_Generated and Objects_Linked

From-SVN: r135623
parent 3ddca462
Showing with 2125 additions and 1558 deletions
gcc/ada/prj-attr.adb
...@@ -86,6 +86,7 @@ package body Prj.Attr is ...@@ -86,6 +86,7 @@ package body Prj.Attr is
"LVlocally_removed_files#" & "LVlocally_removed_files#" &
"LVexcluded_source_files#" & "LVexcluded_source_files#" &
"SVsource_list_file#" & "SVsource_list_file#" &
"LVinterfaces#" &
-- Libraries -- Libraries
...@@ -109,6 +110,8 @@ package body Prj.Attr is ...@@ -109,6 +110,8 @@ package body Prj.Attr is
"LVrun_path_option#" & "LVrun_path_option#" &
"Satoolchain_version#" & "Satoolchain_version#" &
"Satoolchain_description#" & "Satoolchain_description#" &
"Saobject_generated#" &
"Saobjects_linked#" &
-- Configuration - Libraries -- Configuration - Libraries
......
gcc/ada/prj-dect.adb
...@@ -184,7 +184,7 @@ package body Prj.Dect is ...@@ -184,7 +184,7 @@ package body Prj.Dect is
-- an unknown package. -- an unknown package.
if Current_Attribute = Empty_Attribute then if Current_Attribute = Empty_Attribute then
if Current_Package /= Empty_Node if Present (Current_Package)
and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored
then then
Pkg_Id := Package_Id_Of (Current_Package, In_Tree); Pkg_Id := Package_Id_Of (Current_Package, In_Tree);
...@@ -194,7 +194,7 @@ package body Prj.Dect is ...@@ -194,7 +194,7 @@ package body Prj.Dect is
-- If not a valid attribute name, issue an error if inside -- If not a valid attribute name, issue an error if inside
-- a package that need to be checked. -- a package that need to be checked.
Ignore := Current_Package /= Empty_Node and then Ignore := Present (Current_Package) and then
Packages_To_Check /= All_Packages; Packages_To_Check /= All_Packages;
if Ignore then if Ignore then
...@@ -241,7 +241,7 @@ package body Prj.Dect is ...@@ -241,7 +241,7 @@ package body Prj.Dect is
-- Change obsolete names of attributes to the new names -- Change obsolete names of attributes to the new names
if Current_Package /= Empty_Node if Present (Current_Package)
and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
then then
case Name_Of (Attribute, In_Tree) is case Name_Of (Attribute, In_Tree) is
...@@ -403,7 +403,7 @@ package body Prj.Dect is ...@@ -403,7 +403,7 @@ package body Prj.Dect is
The_Project := Imported_Or_Extended_Project_Of The_Project := Imported_Or_Extended_Project_Of
(Current_Project, In_Tree, Token_Name); (Current_Project, In_Tree, Token_Name);
if The_Project = Empty_Node then if No (The_Project) then
Error_Msg ("unknown project", Location); Error_Msg ("unknown project", Location);
Scan (In_Tree); -- past the project name Scan (In_Tree); -- past the project name
...@@ -414,7 +414,7 @@ package body Prj.Dect is ...@@ -414,7 +414,7 @@ package body Prj.Dect is
-- If this is inside a package, a dot followed by the -- If this is inside a package, a dot followed by the
-- name of the package must followed the project name. -- name of the package must followed the project name.
if Current_Package /= Empty_Node then if Present (Current_Package) then
Expect (Tok_Dot, "`.`"); Expect (Tok_Dot, "`.`");
if Token /= Tok_Dot then if Token /= Tok_Dot then
...@@ -445,7 +445,7 @@ package body Prj.Dect is ...@@ -445,7 +445,7 @@ package body Prj.Dect is
-- Look for the package node -- Look for the package node
while The_Package /= Empty_Node while Present (The_Package)
and then and then
Name_Of (The_Package, In_Tree) /= Token_Name Name_Of (The_Package, In_Tree) /= Token_Name
loop loop
...@@ -457,7 +457,7 @@ package body Prj.Dect is ...@@ -457,7 +457,7 @@ package body Prj.Dect is
-- If the package cannot be found in the -- If the package cannot be found in the
-- project, issue an error. -- project, issue an error.
if The_Package = Empty_Node then if No (The_Package) then
The_Project := Empty_Node; The_Project := Empty_Node;
Error_Msg_Name_2 := Project_Name; Error_Msg_Name_2 := Project_Name;
Error_Msg_Name_1 := Token_Name; Error_Msg_Name_1 := Token_Name;
...@@ -473,7 +473,7 @@ package body Prj.Dect is ...@@ -473,7 +473,7 @@ package body Prj.Dect is
end if; end if;
end if; end if;
if The_Project /= Empty_Node then if Present (The_Project) then
-- Looking for '<same attribute name> -- Looking for '<same attribute name>
...@@ -503,7 +503,7 @@ package body Prj.Dect is ...@@ -503,7 +503,7 @@ package body Prj.Dect is
end if; end if;
end if; end if;
if The_Project = Empty_Node then if No (The_Project) then
-- If there were any problem, set the attribute id to null, -- If there were any problem, set the attribute id to null,
-- so that the node will not be recorded. -- so that the node will not be recorded.
...@@ -546,7 +546,7 @@ package body Prj.Dect is ...@@ -546,7 +546,7 @@ package body Prj.Dect is
-- for the attribute, issue an error. -- for the attribute, issue an error.
if Current_Attribute /= Empty_Attribute if Current_Attribute /= Empty_Attribute
and then Expression /= Empty_Node and then Present (Expression)
and then Variable_Kind_Of (Current_Attribute) /= and then Variable_Kind_Of (Current_Attribute) /=
Expression_Kind_Of (Expression, In_Tree) Expression_Kind_Of (Expression, In_Tree)
then then
...@@ -639,10 +639,10 @@ package body Prj.Dect is ...@@ -639,10 +639,10 @@ package body Prj.Dect is
end if; end if;
end if; end if;
if Case_Variable /= Empty_Node then if Present (Case_Variable) then
String_Type := String_Type_Of (Case_Variable, In_Tree); String_Type := String_Type_Of (Case_Variable, In_Tree);
if String_Type = Empty_Node then if No (String_Type) then
Error_Msg ("variable """ & Error_Msg ("variable """ &
Get_Name_String (Name_Of (Case_Variable, In_Tree)) & Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
""" is not typed", """ is not typed",
...@@ -813,15 +813,15 @@ package body Prj.Dect is ...@@ -813,15 +813,15 @@ package body Prj.Dect is
The_Variable : Project_Node_Id := Empty_Node; The_Variable : Project_Node_Id := Empty_Node;
begin begin
if Current_Package /= Empty_Node then if Present (Current_Package) then
The_Variable := The_Variable :=
First_Variable_Of (Current_Package, In_Tree); First_Variable_Of (Current_Package, In_Tree);
elsif Current_Project /= Empty_Node then elsif Present (Current_Project) then
The_Variable := The_Variable :=
First_Variable_Of (Current_Project, In_Tree); First_Variable_Of (Current_Project, In_Tree);
end if; end if;
while The_Variable /= Empty_Node while Present (The_Variable)
and then Name_Of (The_Variable, In_Tree) /= and then Name_Of (The_Variable, In_Tree) /=
Token_Name Token_Name
loop loop
...@@ -831,7 +831,7 @@ package body Prj.Dect is ...@@ -831,7 +831,7 @@ package body Prj.Dect is
-- It is an error to declare a variable in a case -- It is an error to declare a variable in a case
-- construction for the first time. -- construction for the first time.
if The_Variable = Empty_Node then if No (The_Variable) then
Error_Msg Error_Msg
("a variable cannot be declared " & ("a variable cannot be declared " &
"for the first time here", "for the first time here",
...@@ -928,8 +928,8 @@ package body Prj.Dect is ...@@ -928,8 +928,8 @@ package body Prj.Dect is
-- Insert an N_Declarative_Item in the tree, but only if -- Insert an N_Declarative_Item in the tree, but only if
-- Current_Declaration is not an empty node. -- Current_Declaration is not an empty node.
if Current_Declaration /= Empty_Node then if Present (Current_Declaration) then
if Current_Declarative_Item = Empty_Node then if No (Current_Declarative_Item) then
Current_Declarative_Item := Current_Declarative_Item :=
Default_Project_Node Default_Project_Node
(Of_Kind => N_Declarative_Item, In_Tree => In_Tree); (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
...@@ -1056,13 +1056,13 @@ package body Prj.Dect is ...@@ -1056,13 +1056,13 @@ package body Prj.Dect is
First_Package_Of (Current_Project, In_Tree); First_Package_Of (Current_Project, In_Tree);
begin begin
while Current /= Empty_Node while Present (Current)
and then Name_Of (Current, In_Tree) /= Token_Name and then Name_Of (Current, In_Tree) /= Token_Name
loop loop
Current := Next_Package_In_Project (Current, In_Tree); Current := Next_Package_In_Project (Current, In_Tree);
end loop; end loop;
if Current /= Empty_Node then if Present (Current) then
Error_Msg Error_Msg
("package """ & ("package """ &
Get_Name_String (Name_Of (Package_Declaration, In_Tree)) & Get_Name_String (Name_Of (Package_Declaration, In_Tree)) &
...@@ -1110,22 +1110,22 @@ package body Prj.Dect is ...@@ -1110,22 +1110,22 @@ package body Prj.Dect is
(Current_Project, In_Tree), (Current_Project, In_Tree),
In_Tree); In_Tree);
begin begin
while Clause /= Empty_Node loop while Present (Clause) loop
-- Only non limited imported projects may be used in a -- Only non limited imported projects may be used in a
-- renames declaration. -- renames declaration.
The_Project := The_Project :=
Non_Limited_Project_Node_Of (Clause, In_Tree); Non_Limited_Project_Node_Of (Clause, In_Tree);
exit when The_Project /= Empty_Node exit when Present (The_Project)
and then Name_Of (The_Project, In_Tree) = Project_Name; and then Name_Of (The_Project, In_Tree) = Project_Name;
Clause := Next_With_Clause_Of (Clause, In_Tree); Clause := Next_With_Clause_Of (Clause, In_Tree);
end loop; end loop;
if Clause = Empty_Node then if No (Clause) then
-- As we have not found the project in the imports, we check -- As we have not found the project in the imports, we check
-- if it's the name of an eventual extended project. -- if it's the name of an eventual extended project.
if Extended /= Empty_Node if Present (Extended)
and then Name_Of (Extended, In_Tree) = Project_Name and then Name_Of (Extended, In_Tree) = Project_Name
then then
Set_Project_Of_Renamed_Package_Of Set_Project_Of_Renamed_Package_Of
...@@ -1152,8 +1152,8 @@ package body Prj.Dect is ...@@ -1152,8 +1152,8 @@ package body Prj.Dect is
if Name_Of (Package_Declaration, In_Tree) /= Token_Name then if Name_Of (Package_Declaration, In_Tree) /= Token_Name then
Error_Msg ("not the same package name", Token_Ptr); Error_Msg ("not the same package name", Token_Ptr);
elsif elsif
Project_Of_Renamed_Package_Of Present (Project_Of_Renamed_Package_Of
(Package_Declaration, In_Tree) /= Empty_Node (Package_Declaration, In_Tree))
then then
declare declare
Current : Project_Node_Id := Current : Project_Node_Id :=
...@@ -1163,14 +1163,14 @@ package body Prj.Dect is ...@@ -1163,14 +1163,14 @@ package body Prj.Dect is
In_Tree); In_Tree);
begin begin
while Current /= Empty_Node while Present (Current)
and then Name_Of (Current, In_Tree) /= Token_Name and then Name_Of (Current, In_Tree) /= Token_Name
loop loop
Current := Current :=
Next_Package_In_Project (Current, In_Tree); Next_Package_In_Project (Current, In_Tree);
end loop; end loop;
if Current = Empty_Node then if No (Current) then
Error_Msg Error_Msg
("""" & ("""" &
Get_Name_String (Token_Name) & Get_Name_String (Token_Name) &
...@@ -1272,27 +1272,27 @@ package body Prj.Dect is ...@@ -1272,27 +1272,27 @@ package body Prj.Dect is
Set_Name_Of (String_Type, In_Tree, To => Token_Name); Set_Name_Of (String_Type, In_Tree, To => Token_Name);
Current := First_String_Type_Of (Current_Project, In_Tree); Current := First_String_Type_Of (Current_Project, In_Tree);
while Current /= Empty_Node while Present (Current)
and then and then
Name_Of (Current, In_Tree) /= Token_Name Name_Of (Current, In_Tree) /= Token_Name
loop loop
Current := Next_String_Type (Current, In_Tree); Current := Next_String_Type (Current, In_Tree);
end loop; end loop;
if Current /= Empty_Node then if Present (Current) then
Error_Msg ("duplicate string type name """ & Error_Msg ("duplicate string type name """ &
Get_Name_String (Token_Name) & Get_Name_String (Token_Name) &
"""", """",
Token_Ptr); Token_Ptr);
else else
Current := First_Variable_Of (Current_Project, In_Tree); Current := First_Variable_Of (Current_Project, In_Tree);
while Current /= Empty_Node while Present (Current)
and then Name_Of (Current, In_Tree) /= Token_Name and then Name_Of (Current, In_Tree) /= Token_Name
loop loop
Current := Next_Variable (Current, In_Tree); Current := Next_Variable (Current, In_Tree);
end loop; end loop;
if Current /= Empty_Node then if Present (Current) then
Error_Msg ("""" & Error_Msg ("""" &
Get_Name_String (Token_Name) & Get_Name_String (Token_Name) &
""" is already a variable name", Token_Ptr); """ is already a variable name", Token_Ptr);
...@@ -1399,8 +1399,8 @@ package body Prj.Dect is ...@@ -1399,8 +1399,8 @@ package body Prj.Dect is
if OK then if OK then
declare declare
Current : Project_Node_Id := Proj : Project_Node_Id := Current_Project;
First_String_Type_Of (Current_Project, In_Tree); Current : Project_Node_Id := Empty_Node;
begin begin
if Project_String_Type_Name /= No_Name then if Project_String_Type_Name /= No_Name then
...@@ -1414,7 +1414,7 @@ package body Prj.Dect is ...@@ -1414,7 +1414,7 @@ package body Prj.Dect is
begin begin
if The_Project_Name_And_Node = if The_Project_Name_And_Node =
Tree_Private_Part.No_Project_Name_And_Node Tree_Private_Part.No_Project_Name_And_Node
then then
Error_Msg ("unknown project """ & Error_Msg ("unknown project """ &
Get_Name_String Get_Name_String
...@@ -1426,22 +1426,45 @@ package body Prj.Dect is ...@@ -1426,22 +1426,45 @@ package body Prj.Dect is
Current := Current :=
First_String_Type_Of First_String_Type_Of
(The_Project_Name_And_Node.Node, In_Tree); (The_Project_Name_And_Node.Node, In_Tree);
while
Present (Current)
and then
Name_Of (Current, In_Tree) /= String_Type_Name
loop
Current := Next_String_Type (Current, In_Tree);
end loop;
end if; end if;
end; end;
end if;
while Current /= Empty_Node else
and then Name_Of (Current, In_Tree) /= String_Type_Name -- Look for a string type with the correct name in this
loop -- project or in any of its ancestors.
Current := Next_String_Type (Current, In_Tree);
end loop; loop
Current :=
First_String_Type_Of (Proj, In_Tree);
while
Present (Current)
and then
Name_Of (Current, In_Tree) /= String_Type_Name
loop
Current := Next_String_Type (Current, In_Tree);
end loop;
exit when Present (Current);
if Current = Empty_Node then Proj := Parent_Project_Of (Proj, In_Tree);
exit when No (Proj);
end loop;
end if;
if No (Current) then
Error_Msg ("unknown string type """ & Error_Msg ("unknown string type """ &
Get_Name_String (String_Type_Name) & Get_Name_String (String_Type_Name) &
"""", """",
Type_Location); Type_Location);
OK := False; OK := False;
else else
Set_String_Type_Of Set_String_Type_Of
(Variable, In_Tree, To => Current); (Variable, In_Tree, To => Current);
...@@ -1471,7 +1494,7 @@ package body Prj.Dect is ...@@ -1471,7 +1494,7 @@ package body Prj.Dect is
Optional_Index => False); Optional_Index => False);
Set_Expression_Of (Variable, In_Tree, To => Expression); Set_Expression_Of (Variable, In_Tree, To => Expression);
if Expression /= Empty_Node then if Present (Expression) then
-- A typed string must have a single string value, not a list -- A typed string must have a single string value, not a list
if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration
...@@ -1491,27 +1514,27 @@ package body Prj.Dect is ...@@ -1491,27 +1514,27 @@ package body Prj.Dect is
The_Variable : Project_Node_Id := Empty_Node; The_Variable : Project_Node_Id := Empty_Node;
begin begin
if Current_Package /= Empty_Node then if Present (Current_Package) then
The_Variable := First_Variable_Of (Current_Package, In_Tree); The_Variable := First_Variable_Of (Current_Package, In_Tree);
elsif Current_Project /= Empty_Node then elsif Present (Current_Project) then
The_Variable := First_Variable_Of (Current_Project, In_Tree); The_Variable := First_Variable_Of (Current_Project, In_Tree);
end if; end if;
while The_Variable /= Empty_Node while Present (The_Variable)
and then Name_Of (The_Variable, In_Tree) /= Variable_Name and then Name_Of (The_Variable, In_Tree) /= Variable_Name
loop loop
The_Variable := Next_Variable (The_Variable, In_Tree); The_Variable := Next_Variable (The_Variable, In_Tree);
end loop; end loop;
if The_Variable = Empty_Node then if No (The_Variable) then
if Current_Package /= Empty_Node then if Present (Current_Package) then
Set_Next_Variable Set_Next_Variable
(Variable, In_Tree, (Variable, In_Tree,
To => First_Variable_Of (Current_Package, In_Tree)); To => First_Variable_Of (Current_Package, In_Tree));
Set_First_Variable_Of Set_First_Variable_Of
(Current_Package, In_Tree, To => Variable); (Current_Package, In_Tree, To => Variable);
elsif Current_Project /= Empty_Node then elsif Present (Current_Project) then
Set_Next_Variable Set_Next_Variable
(Variable, In_Tree, (Variable, In_Tree,
To => First_Variable_Of (Current_Project, In_Tree)); To => First_Variable_Of (Current_Project, In_Tree));
...@@ -1521,8 +1544,8 @@ package body Prj.Dect is ...@@ -1521,8 +1544,8 @@ package body Prj.Dect is
else else
if Expression_Kind_Of (Variable, In_Tree) /= Undefined then if Expression_Kind_Of (Variable, In_Tree) /= Undefined then
if if Expression_Kind_Of (The_Variable, In_Tree) =
Expression_Kind_Of (The_Variable, In_Tree) = Undefined Undefined
then then
Set_Expression_Kind_Of Set_Expression_Kind_Of
(The_Variable, In_Tree, (The_Variable, In_Tree,
...@@ -1543,7 +1566,6 @@ package body Prj.Dect is ...@@ -1543,7 +1566,6 @@ package body Prj.Dect is
end if; end if;
end; end;
end if; end if;
end Parse_Variable_Declaration; end Parse_Variable_Declaration;
end Prj.Dect; end Prj.Dect;
gcc/ada/prj-makr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -41,7 +41,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; ...@@ -41,7 +41,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with System.Case_Util; use System.Case_Util; with System.Case_Util; use System.Case_Util;
with System.CRTL; with System.CRTL;
with System.Regexp; use System.Regexp;
package body Prj.Makr is package body Prj.Makr is
...@@ -50,6 +49,55 @@ package body Prj.Makr is ...@@ -50,6 +49,55 @@ package body Prj.Makr is
-- All the following need comments ??? All global variables and -- All the following need comments ??? All global variables and
-- subprograms must be fully commented. -- subprograms must be fully commented.
Very_Verbose : Boolean := False;
-- Set in call to Initialize to indicate very verbose output
Project_File : Boolean := False;
-- True when gnatname is creating/modifying a project file. False when
-- gnatname is creating a configuration pragmas file.
Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
-- The project tree where the project file is parsed
Args : Argument_List_Access;
-- The list of arguments for calls to the compiler to get the unit names
-- and kinds (spec or body) in the Ada sources.
Path_Name : String_Access;
Path_Last : Natural;
Directory_Last : Natural := 0;
Output_Name : String_Access;
Output_Name_Last : Natural;
Output_Name_Id : Name_Id;
Project_Naming_File_Name : String_Access;
-- String (1 .. Output_Name'Length + Naming_File_Suffix'Length);
Project_Naming_Last : Natural;
Project_Naming_Id : Name_Id := No_Name;
Source_List_Path : String_Access;
-- (1 .. Output_Name'Length + Source_List_File_Suffix'Length);
Source_List_Last : Natural;
Source_List_FD : File_Descriptor;
Project_Node : Project_Node_Id := Empty_Node;
Project_Declaration : Project_Node_Id := Empty_Node;
Source_Dirs_List : Project_Node_Id := Empty_Node;
Project_Naming_Node : Project_Node_Id := Empty_Node;
Project_Naming_Decl : Project_Node_Id := Empty_Node;
Naming_Package : Project_Node_Id := Empty_Node;
Naming_Package_Comments : Project_Node_Id := Empty_Node;
Source_Files_Comments : Project_Node_Id := Empty_Node;
Source_Dirs_Comments : Project_Node_Id := Empty_Node;
Source_List_File_Comments : Project_Node_Id := Empty_Node;
Naming_String : aliased String := "naming"; Naming_String : aliased String := "naming";
Gnatname_Packages : aliased String_List := (1 => Naming_String'Access); Gnatname_Packages : aliased String_List := (1 => Naming_String'Access);
...@@ -91,6 +139,36 @@ package body Prj.Makr is ...@@ -91,6 +139,36 @@ package body Prj.Makr is
Table_Initial => 10, Table_Initial => 10,
Table_Increment => 100, Table_Increment => 100,
Table_Name => "Prj.Makr.Processed_Directories"); Table_Name => "Prj.Makr.Processed_Directories");
-- The list of already processed directories for each section, to avoid
-- processing several times the same directory in the same section.
package Source_Directories is new Table.Table
(Table_Component_Type => String_Access,
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 10,
Table_Increment => 100,
Table_Name => "Prj.Makr.Source_Directories");
-- The complete list of directories to be put in attribute Source_Dirs in
-- the project file.
type Source is record
File_Name : Name_Id;
Unit_Name : Name_Id;
Index : Int := 0;
Spec : Boolean;
end record;
package Sources is new Table.Table
(Table_Component_Type => Source,
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 10,
Table_Increment => 100,
Table_Name => "Prj.Makr.Sources");
-- The list of Ada sources found, with their unit name and kind, to be put
-- in the source attribute and package Naming of the project file, or in
-- the pragmas Source_File_Name in the configuration pragmas file.
--------- ---------
-- Dup -- -- Dup --
...@@ -112,566 +190,588 @@ package body Prj.Makr is ...@@ -112,566 +190,588 @@ package body Prj.Makr is
Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd)); Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd));
end Dup2; end Dup2;
---------- --------------
-- Make -- -- Finalize --
---------- --------------
procedure Make procedure Finalize is
(File_Path : String; Discard : Boolean;
Project_File : Boolean; pragma Warnings (Off, Discard);
Directories : Argument_List;
Name_Patterns : Argument_List;
Excluded_Patterns : Argument_List;
Foreign_Patterns : Argument_List;
Preproc_Switches : Argument_List;
Very_Verbose : Boolean)
is
Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
Path_Name : String (1 .. File_Path'Length + Current_Source_Dir : Project_Node_Id := Empty_Node;
Project_File_Extension'Length);
Path_Last : Natural := File_Path'Length;
Directory_Last : Natural := 0; begin
if Project_File then
-- If there were no already existing project file, or if the parsing
-- was unsuccessful, create an empty project node with the correct
-- name and its project declaration node.
Output_Name : String (Path_Name'Range); if No (Project_Node) then
Output_Name_Last : Natural; Project_Node :=
Output_Name_Id : Name_Id; Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
Set_Name_Of (Project_Node, Tree, To => Output_Name_Id);
Set_Project_Declaration_Of
(Project_Node, Tree,
To => Default_Project_Node
(Of_Kind => N_Project_Declaration, In_Tree => Tree));
Project_Node : Project_Node_Id := Empty_Node; end if;
Project_Declaration : Project_Node_Id := Empty_Node;
Source_Dirs_List : Project_Node_Id := Empty_Node;
Current_Source_Dir : Project_Node_Id := Empty_Node;
Project_Naming_Node : Project_Node_Id := Empty_Node; end if;
Project_Naming_Decl : Project_Node_Id := Empty_Node;
Naming_Package : Project_Node_Id := Empty_Node;
Naming_Package_Comments : Project_Node_Id := Empty_Node;
Source_Files_Comments : Project_Node_Id := Empty_Node; -- Delete the file if it already exists
Source_Dirs_Comments : Project_Node_Id := Empty_Node;
Source_List_File_Comments : Project_Node_Id := Empty_Node;
Project_Naming_File_Name : String (1 .. Output_Name'Length + Delete_File
Naming_File_Suffix'Length); (Path_Name (Directory_Last + 1 .. Path_Last),
Success => Discard);
Project_Naming_Last : Natural; -- Create a new one
Project_Naming_Id : Name_Id := No_Name;
Excluded_Expressions : array (Excluded_Patterns'Range) of Regexp; if Opt.Verbose_Mode then
Regular_Expressions : array (Name_Patterns'Range) of Regexp; Output.Write_Str ("Creating new file """);
Foreign_Expressions : array (Foreign_Patterns'Range) of Regexp; Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last));
Output.Write_Line ("""");
end if;
Source_List_Path : String (1 .. Output_Name'Length + Output_FD := Create_New_File
Source_List_File_Suffix'Length); (Path_Name (Directory_Last + 1 .. Path_Last),
Source_List_Last : Natural; Fmode => Text);
Source_List_FD : File_Descriptor; -- Fails if project file cannot be created
Args : Argument_List (1 .. Preproc_Switches'Length + 6); if Output_FD = Invalid_FD then
Prj.Com.Fail
("cannot create new """, Path_Name (1 .. Path_Last), """");
end if;
type SFN_Pragma is record if Project_File then
Unit : Name_Id;
File : Name_Id;
Index : Int := 0;
Spec : Boolean;
end record;
package SFN_Pragmas is new Table.Table -- Delete the source list file, if it already exists
(Table_Component_Type => SFN_Pragma,
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 50,
Table_Increment => 100,
Table_Name => "Prj.Makr.SFN_Pragmas");
procedure Process_Directory (Dir_Name : String; Recursively : Boolean); declare
-- Look for Ada and foreign sources in a directory, according to the Discard : Boolean;
-- patterns. When Recursively is True, after looking for sources in pragma Warnings (Off, Discard);
-- Dir_Name, look also in its subdirectories, if any. begin
Delete_File
(Source_List_Path (1 .. Source_List_Last),
Success => Discard);
end;
----------------------- -- And create a new source list file. Fail if file cannot be created.
-- Process_Directory --
-----------------------
procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is Source_List_FD := Create_New_File
Matched : Matched_Type := False; (Name => Source_List_Path (1 .. Source_List_Last),
Str : String (1 .. 2_000); Fmode => Text);
Canon : String (1 .. 2_000);
Last : Natural;
Dir : Dir_Type;
Process : Boolean := True;
Temp_File_Name : String_Access := null; if Source_List_FD = Invalid_FD then
Save_Last_Pragma_Index : Natural := 0; Prj.Com.Fail
File_Name_Id : Name_Id := No_Name; ("cannot create file """,
SFN_Prag : SFN_Pragma; Source_List_Path (1 .. Source_List_Last),
"""");
end if;
begin if Opt.Verbose_Mode then
-- Avoid processing the same directory more than once Output.Write_Str ("Naming project file name is """);
Output.Write_Str
(Project_Naming_File_Name (1 .. Project_Naming_Last));
Output.Write_Line ("""");
end if;
for Index in 1 .. Processed_Directories.Last loop -- Create the naming project node
if Processed_Directories.Table (Index).all = Dir_Name then
Process := False;
exit;
end if;
end loop;
if Process then Project_Naming_Node :=
if Opt.Verbose_Mode then Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
Output.Write_Str ("Processing directory """); Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id);
Output.Write_Str (Dir_Name); Project_Naming_Decl :=
Output.Write_Line (""""); Default_Project_Node
end if; (Of_Kind => N_Project_Declaration, In_Tree => Tree);
Set_Project_Declaration_Of
(Project_Naming_Node, Tree, Project_Naming_Decl);
Naming_Package :=
Default_Project_Node
(Of_Kind => N_Package_Declaration, In_Tree => Tree);
Set_Name_Of (Naming_Package, Tree, To => Name_Naming);
Processed_Directories. Increment_Last; -- Add an attribute declaration for Source_Files as an empty list (to
Processed_Directories.Table (Processed_Directories.Last) := -- indicate there are no sources in the naming project) and a package
new String'(Dir_Name); -- Naming (that will be filled later).
-- Get the source file names from the directory. Fails if the declare
-- directory does not exist. Decl_Item : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Declarative_Item, In_Tree => Tree);
begin Attribute : constant Project_Node_Id :=
Open (Dir, Dir_Name); Default_Project_Node
exception (Of_Kind => N_Attribute_Declaration,
when Directory_Error => In_Tree => Tree,
Prj.Com.Fail ("cannot open directory """, Dir_Name, """"); And_Expr_Kind => List);
end;
-- Process each regular file in the directory Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => List);
File_Loop : loop Term : constant Project_Node_Id :=
Read (Dir, Str, Last); Default_Project_Node
exit File_Loop when Last = 0; (Of_Kind => N_Term,
In_Tree => Tree,
And_Expr_Kind => List);
-- Copy the file name and put it in canonical case to match Empty_List : constant Project_Node_Id :=
-- against the patterns that have themselves already been put Default_Project_Node
-- in canonical case. (Of_Kind => N_Literal_String_List,
In_Tree => Tree);
Canon (1 .. Last) := Str (1 .. Last); begin
Canonical_Case_File_Name (Canon (1 .. Last)); Set_First_Declarative_Item_Of
(Project_Naming_Decl, Tree, To => Decl_Item);
Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_Files);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Empty_List);
end;
if Is_Regular_File -- Add a with clause on the naming project in the main project, if
(Dir_Name & Directory_Separator & Str (1 .. Last)) -- there is not already one.
then
Matched := True;
Name_Len := Last; declare
Name_Buffer (1 .. Name_Len) := Str (1 .. Last); With_Clause : Project_Node_Id :=
File_Name_Id := Name_Find; First_With_Clause_Of (Project_Node, Tree);
-- First, check if the file name matches at least one of begin
-- the excluded expressions; while Present (With_Clause) loop
exit when
Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id;
With_Clause := Next_With_Clause_Of (With_Clause, Tree);
end loop;
for Index in Excluded_Expressions'Range loop if No (With_Clause) then
if With_Clause := Default_Project_Node
Match (Canon (1 .. Last), Excluded_Expressions (Index)) (Of_Kind => N_With_Clause, In_Tree => Tree);
then Set_Next_With_Clause_Of
Matched := Excluded; (With_Clause, Tree,
exit; To => First_With_Clause_Of (Project_Node, Tree));
end if; Set_First_With_Clause_Of
end loop; (Project_Node, Tree, To => With_Clause);
Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id);
-- If it does not match any of the excluded expressions, -- We set the project node to something different than
-- check if the file name matches at least one of the -- Empty_Node, so that Prj.PP does not generate a limited
-- regular expressions. -- with clause.
if Matched = True then Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
Matched := False;
for Index in Regular_Expressions'Range loop Name_Len := Project_Naming_Last;
if Name_Buffer (1 .. Name_Len) :=
Match Project_Naming_File_Name (1 .. Project_Naming_Last);
(Canon (1 .. Last), Regular_Expressions (Index)) Set_String_Value_Of (With_Clause, Tree, To => Name_Find);
then end if;
Matched := True; end;
exit;
end if;
end loop;
end if;
if Very_Verbose Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
or else (Matched = True and then Opt.Verbose_Mode)
then
Output.Write_Str (" Checking """);
Output.Write_Str (Str (1 .. Last));
Output.Write_Line (""": ");
end if;
-- If the file name matches one of the regular expressions, -- Add a package Naming in the main project, that is a renaming of
-- parse it to get its unit name. -- package Naming in the naming project.
if Matched = True then declare
declare Decl_Item : constant Project_Node_Id :=
FD : File_Descriptor; Default_Project_Node
Success : Boolean; (Of_Kind => N_Declarative_Item,
Saved_Output : File_Descriptor; In_Tree => Tree);
Saved_Error : File_Descriptor;
begin Naming : constant Project_Node_Id :=
-- If we don't have the path of the compiler yet, Default_Project_Node
-- get it now. The compiler name may have a prefix, (Of_Kind => N_Package_Declaration,
-- so we get the potentially prefixed name. In_Tree => Tree);
if Gcc_Path = null then begin
declare Set_Next_Declarative_Item
Prefix_Gcc : String_Access := (Decl_Item, Tree,
Program_Name (Gcc); To => First_Declarative_Item_Of (Project_Declaration, Tree));
begin Set_First_Declarative_Item_Of
Gcc_Path := (Project_Declaration, Tree, To => Decl_Item);
Locate_Exec_On_Path (Prefix_Gcc.all); Set_Current_Item_Node (Decl_Item, Tree, To => Naming);
Free (Prefix_Gcc); Set_Name_Of (Naming, Tree, To => Name_Naming);
end; Set_Project_Of_Renamed_Package_Of
(Naming, Tree, To => Project_Naming_Node);
if Gcc_Path = null then
Prj.Com.Fail ("could not locate " & Gcc);
end if;
end if;
-- If we don't have yet the file name of the -- Attach the comments, if any, that were saved for package
-- temporary file, get it now. -- Naming.
if Temp_File_Name = null then Tree.Project_Nodes.Table (Naming).Comments :=
Create_Temp_File (FD, Temp_File_Name); Naming_Package_Comments;
end;
if FD = Invalid_FD then -- Add an attribute declaration for Source_Dirs, initialized as an
Prj.Com.Fail -- empty list.
("could not create temporary file");
end if;
Close (FD); declare
Delete_File (Temp_File_Name.all, Success); Decl_Item : constant Project_Node_Id :=
end if; Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
Args (Args'Last) := new String' Attribute : constant Project_Node_Id :=
(Dir_Name & Default_Project_Node
Directory_Separator & (Of_Kind => N_Attribute_Declaration,
Str (1 .. Last)); In_Tree => Tree,
And_Expr_Kind => List);
-- Create the temporary file Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => List);
FD := Create_Output_Text_File Term : constant Project_Node_Id :=
(Name => Temp_File_Name.all); Default_Project_Node
(Of_Kind => N_Term, In_Tree => Tree,
And_Expr_Kind => List);
if FD = Invalid_FD then begin
Prj.Com.Fail Set_Next_Declarative_Item
("could not create temporary file"); (Decl_Item, Tree,
end if; To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Source_Dirs_List :=
Default_Project_Node
(Of_Kind => N_Literal_String_List,
In_Tree => Tree,
And_Expr_Kind => List);
Set_Current_Term (Term, Tree, To => Source_Dirs_List);
-- Save the standard output and error -- Attach the comments, if any, that were saved for attribute
-- Source_Dirs.
Saved_Output := Dup (Standout); Tree.Project_Nodes.Table (Attribute).Comments :=
Saved_Error := Dup (Standerr); Source_Dirs_Comments;
end;
-- Set standard output and error to the temporary file -- Put the source directories in attribute Source_Dirs
Dup2 (FD, Standout); for Source_Dir_Index in 1 .. Source_Directories.Last loop
Dup2 (FD, Standerr); declare
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => Single);
-- And spawn the compiler Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
In_Tree => Tree,
And_Expr_Kind => Single);
Spawn (Gcc_Path.all, Args, Success); Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
In_Tree => Tree,
And_Expr_Kind => Single);
-- Restore the standard output and error begin
if No (Current_Source_Dir) then
Set_First_Expression_In_List
(Source_Dirs_List, Tree, To => Expression);
else
Set_Next_Expression_In_List
(Current_Source_Dir, Tree, To => Expression);
end if;
Dup2 (Saved_Output, Standout); Current_Source_Dir := Expression;
Dup2 (Saved_Error, Standerr); Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Value);
Name_Len := 0;
Add_Str_To_Name_Buffer
(Source_Directories.Table (Source_Dir_Index).all);
Set_String_Value_Of (Value, Tree, To => Name_Find);
end;
end loop;
-- Close the temporary file -- Add an attribute declaration for Source_Files or Source_List_File
-- with the source list file name that will be created.
Close (FD); declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
-- And close the saved standard output and error to Attribute : constant Project_Node_Id :=
-- avoid too many file descriptors. Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
In_Tree => Tree,
And_Expr_Kind => Single);
Close (Saved_Output); Expression : constant Project_Node_Id :=
Close (Saved_Error); Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => Single);
-- Now that standard output is restored, check if Term : constant Project_Node_Id :=
-- the compiler ran correctly. Default_Project_Node
(Of_Kind => N_Term,
In_Tree => Tree,
And_Expr_Kind => Single);
-- Read the lines of the temporary file: Value : constant Project_Node_Id :=
-- they should contain the kind and name of the unit. Default_Project_Node
(Of_Kind => N_Literal_String,
In_Tree => Tree,
And_Expr_Kind => Single);
declare begin
File : Text_File; Set_Next_Declarative_Item
Text_Line : String (1 .. 1_000); (Decl_Item, Tree,
Text_Last : Natural; To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
begin Set_Name_Of (Attribute, Tree, To => Name_Source_List_File);
Open (File, Temp_File_Name.all); Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Value);
Name_Len := Source_List_Last;
Name_Buffer (1 .. Name_Len) :=
Source_List_Path (1 .. Source_List_Last);
Set_String_Value_Of (Value, Tree, To => Name_Find);
if not Is_Valid (File) then -- If there was no comments for attribute Source_List_File, put
Prj.Com.Fail -- those for Source_Files, if they exist.
("could not read temporary file");
end if;
Save_Last_Pragma_Index := SFN_Pragmas.Last; if Present (Source_List_File_Comments) then
Tree.Project_Nodes.Table (Attribute).Comments :=
Source_List_File_Comments;
else
Tree.Project_Nodes.Table (Attribute).Comments :=
Source_Files_Comments;
end if;
end;
if End_Of_File (File) then -- Put the sources in the source list files and in the naming
if Opt.Verbose_Mode then -- project.
if not Success then
Output.Write_Str (" (process died) ");
end if;
end if;
else for Source_Index in 1 .. Sources.Last loop
Line_Loop : while not End_Of_File (File) loop
Get_Line (File, Text_Line, Text_Last);
-- Find the first closing parenthesis -- Add the corresponding attribute in the
-- Naming package of the naming project.
Char_Loop : for J in 1 .. Text_Last loop declare
if Text_Line (J) = ')' then Current_Source : constant Source :=
if J >= 13 and then Sources.Table (Source_Index);
Text_Line (1 .. 4) = "Unit"
then
-- Add entry to SFN_Pragmas table
Name_Len := J - 12; Decl_Item : constant Project_Node_Id :=
Name_Buffer (1 .. Name_Len) := Default_Project_Node
Text_Line (6 .. J - 7); (Of_Kind =>
SFN_Prag := N_Declarative_Item,
(Unit => Name_Find, In_Tree => Tree);
File => File_Name_Id,
Index => 0,
Spec => Text_Line (J - 5 .. J) =
"(spec)");
SFN_Pragmas.Increment_Last; Attribute : constant Project_Node_Id :=
SFN_Pragmas.Table Default_Project_Node
(SFN_Pragmas.Last) := SFN_Prag; (Of_Kind =>
end if; N_Attribute_Declaration,
exit Char_Loop; In_Tree => Tree);
end if;
end loop Char_Loop; Expression : constant Project_Node_Id :=
end loop Line_Loop; Default_Project_Node
end if; (Of_Kind => N_Expression,
And_Expr_Kind => Single,
In_Tree => Tree);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single,
In_Tree => Tree);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single,
In_Tree => Tree);
if Save_Last_Pragma_Index = SFN_Pragmas.Last then begin
if Opt.Verbose_Mode then -- Add source file name to the source list file
Output.Write_Line (" not a unit");
end if;
else Get_Name_String (Current_Source.File_Name);
if SFN_Pragmas.Last > Add_Char_To_Name_Buffer (ASCII.LF);
Save_Last_Pragma_Index + 1 if Write (Source_List_FD,
then Name_Buffer (1)'Address,
for Index in Save_Last_Pragma_Index + 1 .. Name_Len) /= Name_Len
SFN_Pragmas.Last then
loop Prj.Com.Fail ("disk full");
SFN_Pragmas.Table (Index).Index := end if;
Int (Index - Save_Last_Pragma_Index);
end loop;
end if;
for Index in Save_Last_Pragma_Index + 1 .. -- For an Ada source, add entry in package Naming
SFN_Pragmas.Last
loop if Current_Source.Unit_Name /= No_Name then
SFN_Prag := SFN_Pragmas.Table (Index); Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of
(Naming_Package, Tree),
In_Tree => Tree);
Set_First_Declarative_Item_Of
(Naming_Package,
To => Decl_Item,
In_Tree => Tree);
Set_Current_Item_Node
(Decl_Item,
To => Attribute,
In_Tree => Tree);
-- Is it a spec or a body?
if Current_Source.Spec then
Set_Name_Of
(Attribute, Tree,
To => Name_Spec);
else
Set_Name_Of
(Attribute, Tree,
To => Name_Body);
end if;
if Opt.Verbose_Mode then -- Get the name of the unit
if SFN_Prag.Spec then
Output.Write_Str (" spec of ");
else Get_Name_String (Current_Source.Unit_Name);
Output.Write_Str (" body of "); To_Lower (Name_Buffer (1 .. Name_Len));
end if; Set_Associative_Array_Index_Of
(Attribute, Tree, To => Name_Find);
Output.Write_Line Set_Expression_Of
(Get_Name_String (SFN_Prag.Unit)); (Attribute, Tree, To => Expression);
end if; Set_First_Term
(Expression, Tree, To => Term);
Set_Current_Term
(Term, Tree, To => Value);
if Project_File then -- And set the name of the file
-- Add the corresponding attribute in the Set_String_Value_Of
-- Naming package of the naming project. (Value, Tree, To => Current_Source.File_Name);
Set_Source_Index_Of
(Value, Tree, To => Current_Source.Index);
end if;
end;
end loop;
declare -- Close the source list file
Decl_Item : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind =>
N_Declarative_Item,
In_Tree => Tree);
Attribute : constant Project_Node_Id := Close (Source_List_FD);
Default_Project_Node
(Of_Kind =>
N_Attribute_Declaration,
In_Tree => Tree);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => Single,
In_Tree => Tree);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single,
In_Tree => Tree);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single,
In_Tree => Tree);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of
(Naming_Package, Tree),
In_Tree => Tree);
Set_First_Declarative_Item_Of
(Naming_Package,
To => Decl_Item,
In_Tree => Tree);
Set_Current_Item_Node
(Decl_Item,
To => Attribute,
In_Tree => Tree);
-- Is it a spec or a body?
if SFN_Prag.Spec then
Set_Name_Of
(Attribute, Tree,
To => Name_Spec);
else
Set_Name_Of
(Attribute, Tree,
To => Name_Body);
end if;
-- Get the name of the unit -- Output the project file
Get_Name_String (SFN_Prag.Unit); Prj.PP.Pretty_Print
To_Lower (Name_Buffer (1 .. Name_Len)); (Project_Node, Tree,
Set_Associative_Array_Index_Of W_Char => Write_A_Char'Access,
(Attribute, Tree, To => Name_Find); W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
Backward_Compatibility => False);
Close (Output_FD);
Set_Expression_Of -- Delete the naming project file if it already exists
(Attribute, Tree, To => Expression);
Set_First_Term
(Expression, Tree, To => Term);
Set_Current_Term
(Term, Tree, To => Value);
-- And set the name of the file Delete_File
(Project_Naming_File_Name (1 .. Project_Naming_Last),
Success => Discard);
Set_String_Value_Of -- Create a new one
(Value, Tree, To => File_Name_Id);
Set_Source_Index_Of
(Value, Tree, To => SFN_Prag.Index);
end;
end if;
end loop;
if Project_File then if Opt.Verbose_Mode then
-- Add source file name to source list Output.Write_Str ("Creating new naming project file """);
-- file. Output.Write_Str (Project_Naming_File_Name
(1 .. Project_Naming_Last));
Output.Write_Line ("""");
end if;
Last := Last + 1; Output_FD := Create_New_File
Str (Last) := ASCII.LF; (Project_Naming_File_Name (1 .. Project_Naming_Last),
Fmode => Text);
if Write (Source_List_FD, -- Fails if naming project file cannot be created
Str (1)'Address,
Last) /= Last
then
Prj.Com.Fail ("disk full");
end if;
end if;
end if;
Close (File); if Output_FD = Invalid_FD then
Prj.Com.Fail
("cannot create new """,
Project_Naming_File_Name (1 .. Project_Naming_Last),
"""");
end if;
Delete_File (Temp_File_Name.all, Success); -- Output the naming project file
end;
end;
-- File name matches none of the regular expressions Prj.PP.Pretty_Print
(Project_Naming_Node, Tree,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
Backward_Compatibility => False);
Close (Output_FD);
else else
-- If file is not excluded, see if this is foreign source -- For each Ada source, write a pragma Source_File_Name to the
-- configuration pragmas file.
if Matched /= Excluded then for Index in 1 .. Sources.Last loop
for Index in Foreign_Expressions'Range loop if Sources.Table (Index).Unit_Name /= No_Name then
if Match (Canon (1 .. Last), Write_A_String ("pragma Source_File_Name");
Foreign_Expressions (Index)) Write_Eol;
then Write_A_String (" (");
Matched := True; Write_A_String
exit; (Get_Name_String (Sources.Table (Index).Unit_Name));
end if; Write_A_String (",");
end loop; Write_Eol;
end if;
if Very_Verbose then
case Matched is
when False =>
Output.Write_Line ("no match");
when Excluded =>
Output.Write_Line ("excluded");
when True =>
Output.Write_Line ("foreign source");
end case;
end if;
if Project_File and Matched = True then
-- Add source file name to source list file
Last := Last + 1; if Sources.Table (Index).Spec then
Str (Last) := ASCII.LF; Write_A_String (" Spec_File_Name => """);
if Write (Source_List_FD, else
Str (1)'Address, Write_A_String (" Body_File_Name => """);
Last) /= Last
then
Prj.Com.Fail ("disk full");
end if;
end if;
end if;
end if; end if;
end loop File_Loop;
Close (Dir);
end if;
-- If Recursively is True, call itself for each subdirectory.
-- We do that, even when this directory has already been processed,
-- because all of its subdirectories may not have been processed.
if Recursively then Write_A_String
Open (Dir, Dir_Name); (Get_Name_String (Sources.Table (Index).File_Name));
loop
Read (Dir, Str, Last);
exit when Last = 0;
-- Do not call itself for "." or ".." Write_A_String ("""");
if Is_Directory if Sources.Table (Index).Index /= 0 then
(Dir_Name & Directory_Separator & Str (1 .. Last)) Write_A_String (", Index =>");
and then Str (1 .. Last) /= "." Write_A_String (Sources.Table (Index).Index'Img);
and then Str (1 .. Last) /= ".."
then
Process_Directory
(Dir_Name & Directory_Separator & Str (1 .. Last),
Recursively => True);
end if; end if;
end loop;
Close (Dir); Write_A_String (");");
end if; Write_Eol;
end Process_Directory; end if;
end loop;
Close (Output_FD);
end if;
end Finalize;
-- Start of processing for Make ----------------
-- Initialize --
----------------
procedure Initialize
(File_Path : String;
Project_File : Boolean;
Preproc_Switches : Argument_List;
Very_Verbose : Boolean)
is
begin begin
Makr.Very_Verbose := Initialize.Very_Verbose;
Makr.Project_File := Initialize.Project_File;
-- Do some needed initializations -- Do some needed initializations
Csets.Initialize; Csets.Initialize;
...@@ -680,12 +780,12 @@ package body Prj.Makr is ...@@ -680,12 +780,12 @@ package body Prj.Makr is
Prj.Initialize (No_Project_Tree); Prj.Initialize (No_Project_Tree);
Prj.Tree.Initialize (Tree); Prj.Tree.Initialize (Tree);
SFN_Pragmas.Set_Last (0); Sources.Set_Last (0);
Source_Directories.Set_Last (0);
Processed_Directories.Set_Last (0);
-- Initialize the compiler switches -- Initialize the compiler switches
Args := new Argument_List (1 .. Preproc_Switches'Length + 6);
Args (1) := new String'("-c"); Args (1) := new String'("-c");
Args (2) := new String'("-gnats"); Args (2) := new String'("-gnats");
Args (3) := new String'("-gnatu"); Args (3) := new String'("-gnatu");
...@@ -695,6 +795,10 @@ package body Prj.Makr is ...@@ -695,6 +795,10 @@ package body Prj.Makr is
-- Get the path and file names -- Get the path and file names
Path_Name := new
String (1 .. File_Path'Length + Project_File_Extension'Length);
Path_Last := File_Path'Length;
if File_Names_Case_Sensitive then if File_Names_Case_Sensitive then
Path_Name (1 .. Path_Last) := File_Path; Path_Name (1 .. Path_Last) := File_Path;
else else
...@@ -722,8 +826,8 @@ package body Prj.Makr is ...@@ -722,8 +826,8 @@ package body Prj.Makr is
Path_Last := Path_Name'Last; Path_Last := Path_Name'Last;
end if; end if;
Output_Name (1 .. Path_Last) := To_Lower (Path_Name (1 .. Path_Last)); Output_Name := new String'(To_Lower (Path_Name (1 .. Path_Last)));
Output_Name_Last := Path_Last - Project_File_Extension'Length; Output_Name_Last := Output_Name'Last - 4;
-- If there is already a project file with the specified name, parse -- If there is already a project file with the specified name, parse
-- it to get the components that are not automatically generated. -- it to get the components that are not automatically generated.
...@@ -731,14 +835,14 @@ package body Prj.Makr is ...@@ -731,14 +835,14 @@ package body Prj.Makr is
if Is_Regular_File (Output_Name (1 .. Path_Last)) then if Is_Regular_File (Output_Name (1 .. Path_Last)) then
if Opt.Verbose_Mode then if Opt.Verbose_Mode then
Output.Write_Str ("Parsing already existing project file """); Output.Write_Str ("Parsing already existing project file """);
Output.Write_Str (Output_Name (1 .. Output_Name_Last)); Output.Write_Str (Output_Name.all);
Output.Write_Line (""""); Output.Write_Line ("""");
end if; end if;
Part.Parse Part.Parse
(In_Tree => Tree, (In_Tree => Tree,
Project => Project_Node, Project => Project_Node,
Project_File_Name => Output_Name (1 .. Output_Name_Last), Project_File_Name => Output_Name.all,
Always_Errout_Finalize => False, Always_Errout_Finalize => False,
Store_Comments => True, Store_Comments => True,
Current_Directory => Get_Current_Dir, Current_Directory => Get_Current_Dir,
...@@ -746,7 +850,7 @@ package body Prj.Makr is ...@@ -746,7 +850,7 @@ package body Prj.Makr is
-- Fail if parsing was not successful -- Fail if parsing was not successful
if Project_Node = Empty_Node then if No (Project_Node) then
Fail ("parsing of existing project file failed"); Fail ("parsing of existing project file failed");
else else
...@@ -762,11 +866,11 @@ package body Prj.Makr is ...@@ -762,11 +866,11 @@ package body Prj.Makr is
Previous : Project_Node_Id := Empty_Node; Previous : Project_Node_Id := Empty_Node;
begin begin
while With_Clause /= Empty_Node loop while Present (With_Clause) loop
if Prj.Tree.Name_Of (With_Clause, Tree) = if Prj.Tree.Name_Of (With_Clause, Tree) =
Project_Naming_Id Project_Naming_Id
then then
if Previous = Empty_Node then if No (Previous) then
Set_First_With_Clause_Of Set_First_With_Clause_Of
(Project_Node, Tree, (Project_Node, Tree,
To => Next_With_Clause_Of (With_Clause, Tree)); To => Next_With_Clause_Of (With_Clause, Tree));
...@@ -803,7 +907,7 @@ package body Prj.Makr is ...@@ -803,7 +907,7 @@ package body Prj.Makr is
Comments : Project_Node_Id; Comments : Project_Node_Id;
begin begin
while Declaration /= Empty_Node loop while Present (Declaration) loop
Current_Node := Current_Item_Node (Declaration, Tree); Current_Node := Current_Item_Node (Declaration, Tree);
Kind_Of_Node := Kind_Of (Current_Node, Tree); Kind_Of_Node := Kind_Of (Current_Node, Tree);
...@@ -834,7 +938,7 @@ package body Prj.Makr is ...@@ -834,7 +938,7 @@ package body Prj.Makr is
Naming_Package_Comments := Comments; Naming_Package_Comments := Comments;
end if; end if;
if Previous = Empty_Node then if No (Previous) then
Set_First_Declarative_Item_Of Set_First_Declarative_Item_Of
(Project_Declaration_Of (Project_Node, Tree), (Project_Declaration_Of (Project_Node, Tree),
Tree, Tree,
...@@ -874,12 +978,10 @@ package body Prj.Makr is ...@@ -874,12 +978,10 @@ package body Prj.Makr is
-- Create the project naming file name -- Create the project naming file name
Project_Naming_Last := Output_Name_Last; Project_Naming_Last := Output_Name_Last;
Project_Naming_File_Name (1 .. Project_Naming_Last) := Project_Naming_File_Name :=
Output_Name (1 .. Project_Naming_Last); new String'(Output_Name (1 .. Output_Name_Last) &
Project_Naming_File_Name Naming_File_Suffix &
(Project_Naming_Last + 1 .. Project_File_Extension);
Project_Naming_Last + Naming_File_Suffix'Length) :=
Naming_File_Suffix;
Project_Naming_Last := Project_Naming_Last :=
Project_Naming_Last + Naming_File_Suffix'Length; Project_Naming_Last + Naming_File_Suffix'Length;
...@@ -890,23 +992,17 @@ package body Prj.Makr is ...@@ -890,23 +992,17 @@ package body Prj.Makr is
Project_Naming_File_Name (1 .. Name_Len); Project_Naming_File_Name (1 .. Name_Len);
Project_Naming_Id := Name_Find; Project_Naming_Id := Name_Find;
Project_Naming_File_Name
(Project_Naming_Last + 1 ..
Project_Naming_Last + Project_File_Extension'Length) :=
Project_File_Extension;
Project_Naming_Last := Project_Naming_Last :=
Project_Naming_Last + Project_File_Extension'Length; Project_Naming_Last + Project_File_Extension'Length;
-- Create the source list file name -- Create the source list file name
Source_List_Last := Output_Name_Last; Source_List_Last := Output_Name_Last;
Source_List_Path (1 .. Source_List_Last) := Source_List_Path :=
Output_Name (1 .. Source_List_Last); new String'(Output_Name (1 .. Output_Name_Last) &
Source_List_Path Source_List_File_Suffix);
(Source_List_Last + 1 .. Source_List_Last :=
Source_List_Last + Source_List_File_Suffix'Length) := Output_Name_Last + Source_List_File_Suffix'Length;
Source_List_File_Suffix;
Source_List_Last := Source_List_Last + Source_List_File_Suffix'Length;
-- Add the project file extension to the project name -- Add the project file extension to the project name
...@@ -915,6 +1011,7 @@ package body Prj.Makr is ...@@ -915,6 +1011,7 @@ package body Prj.Makr is
Output_Name_Last + Project_File_Extension'Length) := Output_Name_Last + Project_File_Extension'Length) :=
Project_File_Extension; Project_File_Extension;
Output_Name_Last := Output_Name_Last + Project_File_Extension'Length; Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
end if; end if;
-- Change the current directory to the directory of the project file, -- Change the current directory to the directory of the project file,
...@@ -931,544 +1028,443 @@ package body Prj.Makr is ...@@ -931,544 +1028,443 @@ package body Prj.Makr is
""""); """");
end; end;
end if; end if;
end Initialize;
-------------
-- Process --
-------------
procedure Process
(Directories : Argument_List;
Name_Patterns : Regexp_List;
Excluded_Patterns : Regexp_List;
Foreign_Patterns : Regexp_List)
is
procedure Process_Directory (Dir_Name : String; Recursively : Boolean);
-- Look for Ada and foreign sources in a directory, according to the
-- patterns. When Recursively is True, after looking for sources in
-- Dir_Name, look also in its subdirectories, if any.
if Project_File then -----------------------
-- Process_Directory --
-----------------------
-- Delete the source list file, if it already exists procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is
Matched : Matched_Type := False;
Str : String (1 .. 2_000);
Canon : String (1 .. 2_000);
Last : Natural;
Dir : Dir_Type;
Do_Process : Boolean := True;
declare Temp_File_Name : String_Access := null;
Discard : Boolean; Save_Last_Source_Index : Natural := 0;
pragma Warnings (Off, Discard); File_Name_Id : Name_Id := No_Name;
begin
Delete_File
(Source_List_Path (1 .. Source_List_Last),
Success => Discard);
end;
-- And create a new source list file. Current_Source : Source;
-- Fail if file cannot be created.
Source_List_FD := Create_New_File begin
(Name => Source_List_Path (1 .. Source_List_Last), -- Avoid processing the same directory more than once
Fmode => Text);
if Source_List_FD = Invalid_FD then for Index in 1 .. Processed_Directories.Last loop
Prj.Com.Fail if Processed_Directories.Table (Index).all = Dir_Name then
("cannot create file """, Do_Process := False;
Source_List_Path (1 .. Source_List_Last), exit;
""""); end if;
end if; end loop;
end if;
-- Compile the regular expressions. Fails immediately if any of if Do_Process then
-- the specified strings is in error. if Opt.Verbose_Mode then
Output.Write_Str ("Processing directory """);
Output.Write_Str (Dir_Name);
Output.Write_Line ("""");
end if;
for Index in Excluded_Expressions'Range loop Processed_Directories. Increment_Last;
if Very_Verbose then Processed_Directories.Table (Processed_Directories.Last) :=
Output.Write_Str ("Excluded pattern: """); new String'(Dir_Name);
Output.Write_Str (Excluded_Patterns (Index).all);
Output.Write_Line ("""");
end if;
begin -- Get the source file names from the directory. Fails if the
Excluded_Expressions (Index) := -- directory does not exist.
Compile (Pattern => Excluded_Patterns (Index).all, Glob => True);
exception
when Error_In_Regexp =>
Prj.Com.Fail
("invalid regular expression """,
Excluded_Patterns (Index).all,
"""");
end;
end loop;
for Index in Foreign_Expressions'Range loop begin
if Very_Verbose then Open (Dir, Dir_Name);
Output.Write_Str ("Foreign pattern: """); exception
Output.Write_Str (Foreign_Patterns (Index).all); when Directory_Error =>
Output.Write_Line (""""); Prj.Com.Fail ("cannot open directory """, Dir_Name, """");
end if; end;
begin -- Process each regular file in the directory
Foreign_Expressions (Index) :=
Compile (Pattern => Foreign_Patterns (Index).all, Glob => True);
exception
when Error_In_Regexp =>
Prj.Com.Fail
("invalid regular expression """,
Foreign_Patterns (Index).all,
"""");
end;
end loop;
for Index in Regular_Expressions'Range loop File_Loop : loop
if Very_Verbose then Read (Dir, Str, Last);
Output.Write_Str ("Pattern: """); exit File_Loop when Last = 0;
Output.Write_Str (Name_Patterns (Index).all);
Output.Write_Line ("""");
end if;
begin -- Copy the file name and put it in canonical case to match
Regular_Expressions (Index) := -- against the patterns that have themselves already been put
Compile (Pattern => Name_Patterns (Index).all, Glob => True); -- in canonical case.
exception Canon (1 .. Last) := Str (1 .. Last);
when Error_In_Regexp => Canonical_Case_File_Name (Canon (1 .. Last));
Prj.Com.Fail
("invalid regular expression """,
Name_Patterns (Index).all,
"""");
end;
end loop;
if Project_File then if Is_Regular_File
if Opt.Verbose_Mode then (Dir_Name & Directory_Separator & Str (1 .. Last))
Output.Write_Str ("Naming project file name is """); then
Output.Write_Str Matched := True;
(Project_Naming_File_Name (1 .. Project_Naming_Last));
Output.Write_Line ("""");
end if;
-- If there were no already existing project file, or if the parsing Name_Len := Last;
-- was unsuccessful, create an empty project node with the correct Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
-- name and its project declaration node. File_Name_Id := Name_Find;
if Project_Node = Empty_Node then -- First, check if the file name matches at least one of
Project_Node := -- the excluded expressions;
Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
Set_Name_Of (Project_Node, Tree, To => Output_Name_Id);
Set_Project_Declaration_Of
(Project_Node, Tree,
To => Default_Project_Node
(Of_Kind => N_Project_Declaration, In_Tree => Tree));
end if; for Index in Excluded_Patterns'Range loop
if
Match (Canon (1 .. Last), Excluded_Patterns (Index))
then
Matched := Excluded;
exit;
end if;
end loop;
-- Create the naming project node, and add an attribute declaration -- If it does not match any of the excluded expressions,
-- for Source_Files as an empty list, to indicate there are no -- check if the file name matches at least one of the
-- sources in the naming project. -- regular expressions.
Project_Naming_Node := if Matched = True then
Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); Matched := False;
Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id);
Project_Naming_Decl :=
Default_Project_Node
(Of_Kind => N_Project_Declaration, In_Tree => Tree);
Set_Project_Declaration_Of
(Project_Naming_Node, Tree, Project_Naming_Decl);
Naming_Package :=
Default_Project_Node
(Of_Kind => N_Package_Declaration, In_Tree => Tree);
Set_Name_Of (Naming_Package, Tree, To => Name_Naming);
declare for Index in Name_Patterns'Range loop
Decl_Item : constant Project_Node_Id := if
Default_Project_Node Match
(Of_Kind => N_Declarative_Item, In_Tree => Tree); (Canon (1 .. Last), Name_Patterns (Index))
then
Matched := True;
exit;
end if;
end loop;
end if;
Attribute : constant Project_Node_Id := if Very_Verbose
Default_Project_Node or else (Matched = True and then Opt.Verbose_Mode)
(Of_Kind => N_Attribute_Declaration, then
In_Tree => Tree, Output.Write_Str (" Checking """);
And_Expr_Kind => List); Output.Write_Str (Str (1 .. Last));
Output.Write_Line (""": ");
end if;
Expression : constant Project_Node_Id := -- If the file name matches one of the regular expressions,
Default_Project_Node -- parse it to get its unit name.
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => List);
Term : constant Project_Node_Id := if Matched = True then
Default_Project_Node declare
(Of_Kind => N_Term, FD : File_Descriptor;
In_Tree => Tree, Success : Boolean;
And_Expr_Kind => List); Saved_Output : File_Descriptor;
Saved_Error : File_Descriptor;
Empty_List : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String_List,
In_Tree => Tree);
begin
Set_First_Declarative_Item_Of
(Project_Naming_Decl, Tree, To => Decl_Item);
Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_Files);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Empty_List);
end;
-- Add a with clause on the naming project in the main project, if begin
-- there is not already one. -- If we don't have the path of the compiler yet,
-- get it now. The compiler name may have a prefix,
-- so we get the potentially prefixed name.
declare if Gcc_Path = null then
With_Clause : Project_Node_Id := declare
First_With_Clause_Of (Project_Node, Tree); Prefix_Gcc : String_Access :=
Program_Name (Gcc);
begin
Gcc_Path :=
Locate_Exec_On_Path (Prefix_Gcc.all);
Free (Prefix_Gcc);
end;
begin if Gcc_Path = null then
while With_Clause /= Empty_Node loop Prj.Com.Fail ("could not locate " & Gcc);
exit when end if;
Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id; end if;
With_Clause := Next_With_Clause_Of (With_Clause, Tree);
end loop;
if With_Clause = Empty_Node then -- If we don't have yet the file name of the
With_Clause := Default_Project_Node -- temporary file, get it now.
(Of_Kind => N_With_Clause, In_Tree => Tree);
Set_Next_With_Clause_Of
(With_Clause, Tree,
To => First_With_Clause_Of (Project_Node, Tree));
Set_First_With_Clause_Of
(Project_Node, Tree, To => With_Clause);
Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id);
-- We set the project node to something different than if Temp_File_Name = null then
-- Empty_Node, so that Prj.PP does not generate a limited Create_Temp_File (FD, Temp_File_Name);
-- with clause.
Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node); if FD = Invalid_FD then
Prj.Com.Fail
("could not create temporary file");
end if;
Name_Len := Project_Naming_Last; Close (FD);
Name_Buffer (1 .. Name_Len) := Delete_File (Temp_File_Name.all, Success);
Project_Naming_File_Name (1 .. Project_Naming_Last); end if;
Set_String_Value_Of (With_Clause, Tree, To => Name_Find);
end if;
end;
Project_Declaration := Project_Declaration_Of (Project_Node, Tree); Args (Args'Last) := new String'
(Dir_Name &
Directory_Separator &
Str (1 .. Last));
-- Add a renaming declaration for package Naming in the main project -- Create the temporary file
declare FD := Create_Output_Text_File
Decl_Item : constant Project_Node_Id := (Name => Temp_File_Name.all);
Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
Naming : constant Project_Node_Id := if FD = Invalid_FD then
Default_Project_Node Prj.Com.Fail
(Of_Kind => N_Package_Declaration, ("could not create temporary file");
In_Tree => Tree); end if;
begin -- Save the standard output and error
Set_Next_Declarative_Item
(Decl_Item, Tree,
To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Naming);
Set_Name_Of (Naming, Tree, To => Name_Naming);
Set_Project_Of_Renamed_Package_Of
(Naming, Tree, To => Project_Naming_Node);
-- Attach the comments, if any, that were saved for package Saved_Output := Dup (Standout);
-- Naming. Saved_Error := Dup (Standerr);
Tree.Project_Nodes.Table (Naming).Comments := -- Set standard output and error to the temporary file
Naming_Package_Comments;
end;
-- Add an attribute declaration for Source_Dirs, initialized as an Dup2 (FD, Standout);
-- empty list. Directories will be added as they are read from the Dup2 (FD, Standerr);
-- directory list file.
declare -- And spawn the compiler
Decl_Item : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
Attribute : constant Project_Node_Id := Spawn (Gcc_Path.all, Args.all, Success);
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
In_Tree => Tree,
And_Expr_Kind => List);
Expression : constant Project_Node_Id := -- Restore the standard output and error
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => List);
Term : constant Project_Node_Id := Dup2 (Saved_Output, Standout);
Default_Project_Node Dup2 (Saved_Error, Standerr);
(Of_Kind => N_Term, In_Tree => Tree,
And_Expr_Kind => List);
begin -- Close the temporary file
Set_Next_Declarative_Item
(Decl_Item, Tree,
To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Source_Dirs_List :=
Default_Project_Node
(Of_Kind => N_Literal_String_List,
In_Tree => Tree,
And_Expr_Kind => List);
Set_Current_Term (Term, Tree, To => Source_Dirs_List);
-- Attach the comments, if any, that were saved for attribute Close (FD);
-- Source_Dirs.
Tree.Project_Nodes.Table (Attribute).Comments := -- And close the saved standard output and error to
Source_Dirs_Comments; -- avoid too many file descriptors.
end;
-- Add an attribute declaration for Source_List_File with the Close (Saved_Output);
-- source list file name that will be created. Close (Saved_Error);
declare -- Now that standard output is restored, check if
Decl_Item : constant Project_Node_Id := -- the compiler ran correctly.
Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
Attribute : constant Project_Node_Id := -- Read the lines of the temporary file:
Default_Project_Node -- they should contain the kind and name of the unit.
(Of_Kind => N_Attribute_Declaration,
In_Tree => Tree,
And_Expr_Kind => Single);
Expression : constant Project_Node_Id := declare
Default_Project_Node File : Text_File;
(Of_Kind => N_Expression, Text_Line : String (1 .. 1_000);
In_Tree => Tree, Text_Last : Natural;
And_Expr_Kind => Single);
Term : constant Project_Node_Id := begin
Default_Project_Node Open (File, Temp_File_Name.all);
(Of_Kind => N_Term,
In_Tree => Tree,
And_Expr_Kind => Single);
Value : constant Project_Node_Id := if not Is_Valid (File) then
Default_Project_Node Prj.Com.Fail
(Of_Kind => N_Literal_String, ("could not read temporary file");
In_Tree => Tree, end if;
And_Expr_Kind => Single);
begin Save_Last_Source_Index := Sources.Last;
Set_Next_Declarative_Item
(Decl_Item, Tree,
To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_List_File);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Value);
Name_Len := Source_List_Last;
Name_Buffer (1 .. Name_Len) :=
Source_List_Path (1 .. Source_List_Last);
Set_String_Value_Of (Value, Tree, To => Name_Find);
-- If there was no comments for attribute Source_List_File, put if End_Of_File (File) then
-- those for Source_Files, if they exist. if Opt.Verbose_Mode then
if not Success then
Output.Write_Str (" (process died) ");
end if;
end if;
if Source_List_File_Comments /= Empty_Node then else
Tree.Project_Nodes.Table (Attribute).Comments := Line_Loop : while not End_Of_File (File) loop
Source_List_File_Comments; Get_Line (File, Text_Line, Text_Last);
else
Tree.Project_Nodes.Table (Attribute).Comments :=
Source_Files_Comments;
end if;
end;
end if;
-- Process each directory -- Find the first closing parenthesis
for Index in Directories'Range loop Char_Loop : for J in 1 .. Text_Last loop
if Text_Line (J) = ')' then
if J >= 13 and then
Text_Line (1 .. 4) = "Unit"
then
-- Add entry to Sources table
declare Name_Len := J - 12;
Dir_Name : constant String := Directories (Index).all; Name_Buffer (1 .. Name_Len) :=
Last : Natural := Dir_Name'Last; Text_Line (6 .. J - 7);
Recursively : Boolean := False; Current_Source :=
(Unit_Name => Name_Find,
File_Name => File_Name_Id,
Index => 0,
Spec => Text_Line (J - 5 .. J) =
"(spec)");
begin Sources.Append (Current_Source);
if Dir_Name'Length >= 4 end if;
and then (Dir_Name (Last - 2 .. Last) = "/**")
then
Last := Last - 3;
Recursively := True;
end if;
if Project_File then exit Char_Loop;
end if;
end loop Char_Loop;
end loop Line_Loop;
end if;
-- Add the directory in the list for attribute Source_Dirs if Save_Last_Source_Index = Sources.Last then
if Opt.Verbose_Mode then
Output.Write_Line (" not a unit");
end if;
declare else
Expression : constant Project_Node_Id := if Sources.Last >
Default_Project_Node Save_Last_Source_Index + 1
(Of_Kind => N_Expression, then
In_Tree => Tree, for Index in Save_Last_Source_Index + 1 ..
And_Expr_Kind => Single); Sources.Last
loop
Term : constant Project_Node_Id := Sources.Table (Index).Index :=
Default_Project_Node Int (Index - Save_Last_Source_Index);
(Of_Kind => N_Term, end loop;
In_Tree => Tree, end if;
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
In_Tree => Tree,
And_Expr_Kind => Single);
begin for Index in Save_Last_Source_Index + 1 ..
if Current_Source_Dir = Empty_Node then Sources.Last
Set_First_Expression_In_List loop
(Source_Dirs_List, Tree, To => Expression); Current_Source := Sources.Table (Index);
else
Set_Next_Expression_In_List
(Current_Source_Dir, Tree, To => Expression);
end if;
Current_Source_Dir := Expression; if Opt.Verbose_Mode then
Set_First_Term (Expression, Tree, To => Term); if Current_Source.Spec then
Set_Current_Term (Term, Tree, To => Value); Output.Write_Str (" spec of ");
Name_Len := Dir_Name'Length;
Name_Buffer (1 .. Name_Len) := Dir_Name;
Set_String_Value_Of (Value, Tree, To => Name_Find);
end;
end if;
Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively); else
end; Output.Write_Str (" body of ");
end if;
end loop; Output.Write_Line
(Get_Name_String
(Current_Source.Unit_Name));
end if;
end loop;
end if;
if Project_File then Close (File);
Close (Source_List_FD);
end if;
declare Delete_File (Temp_File_Name.all, Success);
Discard : Boolean; end;
pragma Warnings (Off, Discard); end;
begin -- File name matches none of the regular expressions
-- Delete the file if it already exists
Delete_File else
(Path_Name (Directory_Last + 1 .. Path_Last), -- If file is not excluded, see if this is foreign source
Success => Discard);
-- Create a new one if Matched /= Excluded then
for Index in Foreign_Patterns'Range loop
if Match (Canon (1 .. Last),
Foreign_Patterns (Index))
then
Matched := True;
exit;
end if;
end loop;
end if;
if Opt.Verbose_Mode then if Very_Verbose then
Output.Write_Str ("Creating new file """); case Matched is
Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last)); when False =>
Output.Write_Line (""""); Output.Write_Line ("no match");
end if;
Output_FD := Create_New_File when Excluded =>
(Path_Name (Directory_Last + 1 .. Path_Last), Output.Write_Line ("excluded");
Fmode => Text);
-- Fails if project file cannot be created when True =>
Output.Write_Line ("foreign source");
end case;
end if;
if Output_FD = Invalid_FD then if Matched = True then
Prj.Com.Fail
("cannot create new """, Path_Name (1 .. Path_Last), """");
end if;
if Project_File then -- Add source file name without unit name
-- Output the project file Name_Len := 0;
Add_Str_To_Name_Buffer (Canon (1 .. Last));
Sources.Append
((File_Name => Name_Find,
Unit_Name => No_Name,
Index => 0,
Spec => False));
end if;
end if;
end if;
end loop File_Loop;
Prj.PP.Pretty_Print Close (Dir);
(Project_Node, Tree, end if;
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
Backward_Compatibility => False);
Close (Output_FD);
-- Delete the naming project file if it already exists -- If Recursively is True, call itself for each subdirectory.
-- We do that, even when this directory has already been processed,
-- because all of its subdirectories may not have been processed.
Delete_File if Recursively then
(Project_Naming_File_Name (1 .. Project_Naming_Last), Open (Dir, Dir_Name);
Success => Discard);
-- Create a new one loop
Read (Dir, Str, Last);
exit when Last = 0;
if Opt.Verbose_Mode then -- Do not call itself for "." or ".."
Output.Write_Str ("Creating new naming project file """);
Output.Write_Str (Project_Naming_File_Name
(1 .. Project_Naming_Last));
Output.Write_Line ("""");
end if;
Output_FD := Create_New_File if Is_Directory
(Project_Naming_File_Name (1 .. Project_Naming_Last), (Dir_Name & Directory_Separator & Str (1 .. Last))
Fmode => Text); and then Str (1 .. Last) /= "."
and then Str (1 .. Last) /= ".."
then
Process_Directory
(Dir_Name & Directory_Separator & Str (1 .. Last),
Recursively => True);
end if;
end loop;
-- Fails if naming project file cannot be created Close (Dir);
end if;
end Process_Directory;
if Output_FD = Invalid_FD then -- Start of processing for Process
Prj.Com.Fail
("cannot create new """,
Project_Naming_File_Name (1 .. Project_Naming_Last),
"""");
end if;
-- Output the naming project file begin
Processed_Directories.Set_Last (0);
Prj.PP.Pretty_Print -- Process each directory
(Project_Naming_Node, Tree,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
Backward_Compatibility => False);
Close (Output_FD);
else for Index in Directories'Range loop
-- Write to the output file each entry in the SFN_Pragmas table
-- as an pragma Source_File_Name.
for Index in 1 .. SFN_Pragmas.Last loop declare
Write_A_String ("pragma Source_File_Name"); Dir_Name : constant String := Directories (Index).all;
Write_Eol; Last : Natural := Dir_Name'Last;
Write_A_String (" ("); Recursively : Boolean := False;
Write_A_String Found : Boolean;
(Get_Name_String (SFN_Pragmas.Table (Index).Unit)); Canonical : String (1 .. Dir_Name'Length) := Dir_Name;
Write_A_String (",");
Write_Eol;
if SFN_Pragmas.Table (Index).Spec then begin
Write_A_String (" Spec_File_Name => """); Canonical_Case_File_Name (Canonical);
else Found := False;
Write_A_String (" Body_File_Name => """); for J in 1 .. Source_Directories.Last loop
if Source_Directories.Table (J).all = Canonical then
Found := True;
exit;
end if; end if;
end loop;
Write_A_String if not Found then
(Get_Name_String (SFN_Pragmas.Table (Index).File)); Source_Directories.Append (new String'(Canonical));
end if;
Write_A_String ("""");
if SFN_Pragmas.Table (Index).Index /= 0 then
Write_A_String (", Index =>");
Write_A_String (SFN_Pragmas.Table (Index).Index'Img);
end if;
Write_A_String (");"); if Dir_Name'Length >= 4
Write_Eol; and then (Dir_Name (Last - 2 .. Last) = "/**")
end loop; then
Last := Last - 3;
Recursively := True;
end if;
Close (Output_FD); Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively);
end if; end;
end;
end Make; end loop;
end Process;
---------------- ----------------
-- Write_Char -- -- Write_Char --
......
gcc/ada/prj-makr.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -25,44 +25,58 @@ ...@@ -25,44 +25,58 @@
-- Support for procedure Gnatname -- Support for procedure Gnatname
-- For arbitrary naming schemes, create or update a project file, -- For arbitrary naming schemes, create or update a project file, or create a
-- or create a configuration pragmas file. -- configuration pragmas file.
with System.Regexp; use System.Regexp;
package Prj.Makr is package Prj.Makr is
procedure Make procedure Initialize
(File_Path : String; (File_Path : String;
Project_File : Boolean; Project_File : Boolean;
Directories : Argument_List;
Name_Patterns : Argument_List;
Excluded_Patterns : Argument_List;
Foreign_Patterns : Argument_List;
Preproc_Switches : Argument_List; Preproc_Switches : Argument_List;
Very_Verbose : Boolean); Very_Verbose : Boolean);
-- Create a project file or a configuration pragmas file -- Start the creation of a configuration pragmas file or the creation or
-- modification of a project file, for gnatname.
--
-- When Project_File is False, File_Path is the name of a configuration
-- pragmas file to create. When Project_File is True, File_Path is the name
-- of a project file to create if it does not exist or to modify if it
-- already exists.
--
-- Preproc_Switches is a list of switches to be used when invoking the
-- compiler to get the name and kind of unit of a source file.
--
-- Very_Verbose controls the verbosity of the output, in conjunction with
-- Opt.Verbose_Mode.
type Regexp_List is array (Positive range <>) of Regexp;
procedure Process
(Directories : Argument_List;
Name_Patterns : Regexp_List;
Excluded_Patterns : Regexp_List;
Foreign_Patterns : Regexp_List);
-- Look for source files in the specified directories, with the specified
-- patterns.
--
-- Directories is the list of source directories where to look for sources.
-- --
-- Project_File is the path name of the project file. If the project -- Name_Patterns is a potentially empty list of file name patterns to check
-- file already exists parse it and keep all the elements that are not -- for Ada Sources.
-- automatically generated.
-- --
-- Directory_List_File is the path name of a text file that -- Excluded_Patterns is a potentially empty list of file name patterns that
-- contains on each non empty line the path names of the source -- should not be checked for Ada or non Ada sources.
-- directories for the project file. The source directories
-- are relative to the directory of the project file.
-- --
-- File_Name_Patterns is a GNAT.Regexp string pattern such as -- Foreign_Patterns is a potentially empty list of file name patterns to
-- ".*\.ads|.*\.adb" or any other pattern. -- check for non Ada sources.
-- --
-- A project file (without any sources) is automatically generated -- At least one of Name_Patterns and Foreign_Patterns is not empty
-- with the name <project>_naming. It contains a package Naming with
-- all the specs and bodies for the project.
-- A file containing the source file names is automatically
-- generated and used as the Source_File_List for the project file.
-- It includes all sources that follow the Foreign_Patterns (except those
-- that follow Excluded_Patterns).
-- Preproc_switches is a list of optional preprocessor switches -gnatep= procedure Finalize;
-- and -gnateD that are used when invoking the compiler to find the -- Write the configuration pragmas file or the project file indicated in a
-- unit name and kind. -- call to procedure Initialize, after one or several calls to procedure
-- Process.
end Prj.Makr; end Prj.Makr;
gcc/ada/prj-nmsc.adb
...@@ -138,6 +138,9 @@ package body Prj.Nmsc is ...@@ -138,6 +138,9 @@ package body Prj.Nmsc is
Unit : Name_Id; Unit : Name_Id;
Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception; Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception;
end record; end record;
-- Comment needed???
-- Why is the following commented out ???
-- No_Unit : constant Unit_Info := -- No_Unit : constant Unit_Info :=
-- (Specification, No_Name, No_Ada_Naming_Exception); -- (Specification, No_Name, No_Ada_Naming_Exception);
...@@ -165,6 +168,7 @@ package body Prj.Nmsc is ...@@ -165,6 +168,7 @@ package body Prj.Nmsc is
Location : Source_Ptr := No_Location; Location : Source_Ptr := No_Location;
end record; end record;
No_File_Found : constant File_Found := (No_File, False, No_Location); No_File_Found : constant File_Found := (No_File, False, No_Location);
-- Comments needed ???
package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
...@@ -223,6 +227,7 @@ package body Prj.Nmsc is ...@@ -223,6 +227,7 @@ package body Prj.Nmsc is
-- Add a new source to the different lists: list of all sources in the -- Add a new source to the different lists: list of all sources in the
-- project tree, list of source of a project and list of sources of a -- project tree, list of source of a project and list of sources of a
-- language. -- language.
--
-- If Path is specified, the file is also added to Source_Paths_HT. -- If Path is specified, the file is also added to Source_Paths_HT.
-- If Source_To_Replace is specified, it points to the source in the -- If Source_To_Replace is specified, it points to the source in the
-- extended project that the new file is overriding. -- extended project that the new file is overriding.
...@@ -272,6 +277,13 @@ package body Prj.Nmsc is ...@@ -272,6 +277,13 @@ package body Prj.Nmsc is
-- Check attribute Externally_Built of project Project in project tree -- Check attribute Externally_Built of project Project in project tree
-- In_Tree and modify its data Data if it has the value "true". -- In_Tree and modify its data Data if it has the value "true".
procedure Check_Interfaces
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data);
-- If a list of sources is specified in attribute Interfaces, set
-- In_Interfaces only for the sources specified in the list.
procedure Check_Library_Attributes procedure Check_Library_Attributes
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
...@@ -317,10 +329,10 @@ package body Prj.Nmsc is ...@@ -317,10 +329,10 @@ package body Prj.Nmsc is
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
procedure Get_Path_Names_And_Record_Ada_Sources procedure Get_Path_Names_And_Record_Ada_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
Current_Dir : String); Current_Dir : String);
-- Find the path names of the source files in the Source_Names table -- Find the path names of the source files in the Source_Names table
-- in the source directories and record those that are Ada sources. -- in the source directories and record those that are Ada sources.
...@@ -356,10 +368,10 @@ package body Prj.Nmsc is ...@@ -356,10 +368,10 @@ package body Prj.Nmsc is
-- a specified language. -- a specified language.
procedure Search_Directories procedure Search_Directories
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
For_All_Sources : Boolean); For_All_Sources : Boolean);
-- Search the source directories to find the sources. -- Search the source directories to find the sources.
-- If For_All_Sources is True, check each regular file name against the -- If For_All_Sources is True, check each regular file name against the
-- naming schemes of the different languages. Otherwise consider only the -- naming schemes of the different languages. Otherwise consider only the
...@@ -407,8 +419,10 @@ package body Prj.Nmsc is ...@@ -407,8 +419,10 @@ package body Prj.Nmsc is
Kind : out Source_Kind); Kind : out Source_Kind);
-- Check if the file name File_Name conforms to one of the naming -- Check if the file name File_Name conforms to one of the naming
-- schemes of the project. -- schemes of the project.
--
-- If the file does not match one of the naming schemes, set Language -- If the file does not match one of the naming schemes, set Language
-- to No_Language_Index. -- to No_Language_Index.
--
-- Filename is the name of the file being investigated. It has been -- Filename is the name of the file being investigated. It has been
-- normalized (case-folded). File_Name is the same value. -- normalized (case-folded). File_Name is the same value.
...@@ -422,6 +436,7 @@ package body Prj.Nmsc is ...@@ -422,6 +436,7 @@ package body Prj.Nmsc is
Data : in out Project_Data); Data : in out Project_Data);
-- Get the object directory, the exec directory and the source directories -- Get the object directory, the exec directory and the source directories
-- of a project. -- of a project.
--
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
...@@ -448,6 +463,7 @@ package body Prj.Nmsc is ...@@ -448,6 +463,7 @@ package body Prj.Nmsc is
Data : in out Project_Data); Data : in out Project_Data);
-- Process the Source_Files and Source_List_File attributes, and store -- Process the Source_Files and Source_List_File attributes, and store
-- the list of source files into the Source_Names htable. -- the list of source files into the Source_Names htable.
--
-- Lang indicates which language is being processed when in Ada_Only mode -- Lang indicates which language is being processed when in Ada_Only mode
-- (all languages are processed anyway when in Multi_Language mode). -- (all languages are processed anyway when in Multi_Language mode).
...@@ -488,24 +504,26 @@ package body Prj.Nmsc is ...@@ -488,24 +504,26 @@ package body Prj.Nmsc is
-- is True and Create is a non null string, an attempt is made to create -- is True and Create is a non null string, an attempt is made to create
-- the directory. If the directory does not exist and Project_Setup is -- the directory. If the directory does not exist and Project_Setup is
-- false, then Dir and Display are set to No_Name. -- false, then Dir and Display are set to No_Name.
--
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
procedure Look_For_Sources procedure Look_For_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
Current_Dir : String); Current_Dir : String);
-- Find all the sources of project Project in project tree In_Tree and -- Find all the sources of project Project in project tree In_Tree and
-- update its Data accordingly. -- update its Data accordingly.
--
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
function Path_Name_Of function Path_Name_Of
(File_Name : File_Name_Type; (File_Name : File_Name_Type;
Directory : Path_Name_Type) return String; Directory : Path_Name_Type) return String;
-- Returns the path name of a (non project) file. -- Returns the path name of a (non project) file. Returns an empty string
-- Returns an empty string if file cannot be found. -- if file cannot be found.
procedure Prepare_Ada_Naming_Exceptions procedure Prepare_Ada_Naming_Exceptions
(List : Array_Element_Id; (List : Array_Element_Id;
...@@ -533,6 +551,7 @@ package body Prj.Nmsc is ...@@ -533,6 +551,7 @@ package body Prj.Nmsc is
Current_Dir : String); Current_Dir : String);
-- Put a unit in the list of units of a project, if the file name -- Put a unit in the list of units of a project, if the file name
-- corresponds to a valid unit name. -- corresponds to a valid unit name.
--
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
...@@ -542,9 +561,9 @@ package body Prj.Nmsc is ...@@ -542,9 +561,9 @@ package body Prj.Nmsc is
Data : in out Project_Data; Data : in out Project_Data;
Language : Language_Index; Language : Language_Index;
Naming_Exceptions : Boolean); Naming_Exceptions : Boolean);
-- Record the sources of a language in a project. -- Record the sources of a language in a project. When Naming_Exceptions is
-- When Naming_Exceptions is True, mark the found sources as such, to -- True, mark the found sources as such, to later remove those that are not
-- later remove those that are not named in a list of sources. -- named in a list of sources.
procedure Remove_Source procedure Remove_Source
(Id : Source_Id; (Id : Source_Id;
...@@ -555,10 +574,11 @@ package body Prj.Nmsc is ...@@ -555,10 +574,11 @@ package body Prj.Nmsc is
-- ??? needs comment -- ??? needs comment
procedure Report_No_Sources procedure Report_No_Sources
(Project : Project_Id; (Project : Project_Id;
Lang_Name : String; Lang_Name : String;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Location : Source_Ptr); Location : Source_Ptr;
Continuation : Boolean := False);
-- Report an error or a warning depending on the value of When_No_Sources -- Report an error or a warning depending on the value of When_No_Sources
-- when there are no sources for language Lang_Name. -- when there are no sources for language Lang_Name.
...@@ -570,8 +590,8 @@ package body Prj.Nmsc is ...@@ -570,8 +590,8 @@ package body Prj.Nmsc is
(Language : Language_Index; (Language : Language_Index;
Naming : Naming_Data; Naming : Naming_Data;
In_Tree : Project_Tree_Ref) return File_Name_Type; In_Tree : Project_Tree_Ref) return File_Name_Type;
-- Get the suffix for the source of a language from a package naming. -- Get the suffix for the source of a language from a package naming. If
-- If not specified, return the default for the language. -- not specified, return the default for the language.
procedure Warn_If_Not_Sources procedure Warn_If_Not_Sources
(Project : Project_Id; (Project : Project_Id;
...@@ -608,6 +628,8 @@ package body Prj.Nmsc is ...@@ -608,6 +628,8 @@ package body Prj.Nmsc is
is is
Source : constant Source_Id := Data.Last_Source; Source : constant Source_Id := Data.Last_Source;
Src_Data : Source_Data := No_Source_Data; Src_Data : Source_Data := No_Source_Data;
Config : constant Language_Config :=
In_Tree.Languages_Data.Table (Lang_Id).Config;
begin begin
-- This is a new source so create an entry for it in the Sources table -- This is a new source so create an entry for it in the Sources table
...@@ -639,6 +661,14 @@ package body Prj.Nmsc is ...@@ -639,6 +661,14 @@ package body Prj.Nmsc is
Src_Data.Kind := Kind; Src_Data.Kind := Kind;
Src_Data.Alternate_Languages := Alternate_Languages; Src_Data.Alternate_Languages := Alternate_Languages;
Src_Data.Other_Part := Other_Part; Src_Data.Other_Part := Other_Part;
Src_Data.Object_Exists := Config.Object_Generated;
Src_Data.Object_Linked := Config.Objects_Linked;
if Other_Part /= No_Source then
In_Tree.Sources.Table (Other_Part).Other_Part := Id;
end if;
Src_Data.Unit := Unit; Src_Data.Unit := Unit;
Src_Data.Index := Index; Src_Data.Index := Index;
Src_Data.File := File_Name; Src_Data.File := File_Name;
...@@ -741,8 +771,7 @@ package body Prj.Nmsc is ...@@ -741,8 +771,7 @@ package body Prj.Nmsc is
if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
Error_Msg Error_Msg
(Project, (Project, In_Tree,
In_Tree,
"an abstract project need to have no language, no sources or no " & "an abstract project need to have no language, no sources or no " &
"source directories", "source directories",
Data.Location); Data.Location);
...@@ -804,6 +833,7 @@ package body Prj.Nmsc is ...@@ -804,6 +833,7 @@ package body Prj.Nmsc is
Src_Data : Source_Data; Src_Data : Source_Data;
Alt_Lang : Alternate_Language_Id; Alt_Lang : Alternate_Language_Id;
Alt_Lang_Data : Alternate_Language_Data; Alt_Lang_Data : Alternate_Language_Data;
Continuation : Boolean := False;
begin begin
Language := Data.First_Language_Processing; Language := Data.First_Language_Processing;
...@@ -835,7 +865,9 @@ package body Prj.Nmsc is ...@@ -835,7 +865,9 @@ package body Prj.Nmsc is
(In_Tree.Languages_Data.Table (In_Tree.Languages_Data.Table
(Language).Display_Name), (Language).Display_Name),
In_Tree, In_Tree,
Data.Location); Data.Location,
Continuation);
Continuation := True;
end if; end if;
Language := In_Tree.Languages_Data.Table (Language).Next; Language := In_Tree.Languages_Data.Table (Language).Next;
...@@ -844,6 +876,14 @@ package body Prj.Nmsc is ...@@ -844,6 +876,14 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
if Get_Mode = Multi_Language then
-- If a list of sources is specified in attribute Interfaces, set
-- In_Interfaces only for the sources specified in the list.
Check_Interfaces (Project, In_Tree, Data);
end if;
-- If it is a library project file, check if it is a standalone library -- If it is a library project file, check if it is a standalone library
if Data.Library then if Data.Library then
...@@ -2197,6 +2237,69 @@ package body Prj.Nmsc is ...@@ -2197,6 +2237,69 @@ package body Prj.Nmsc is
(Lang_Index).Config.Runtime_Library_Dir := (Lang_Index).Config.Runtime_Library_Dir :=
Element.Value.Value; Element.Value.Value;
when Name_Object_Generated =>
declare
pragma Unsuppress (All_Checks);
Value : Boolean;
begin
Value :=
Boolean'Value
(Get_Name_String (Element.Value.Value));
In_Tree.Languages_Data.Table
(Lang_Index).Config.Object_Generated := Value;
-- If no object is generated, no object may be
-- linked.
if not Value then
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Linked := False;
end if;
exception
when Constraint_Error =>
Error_Msg
(Project,
In_Tree,
"invalid value """
& Get_Name_String (Element.Value.Value)
& """ for Object_Generated",
Element.Value.Location);
end;
when Name_Objects_Linked =>
declare
pragma Unsuppress (All_Checks);
Value : Boolean;
begin
Value :=
Boolean'Value
(Get_Name_String (Element.Value.Value));
-- No change if Object_Generated is False, as this
-- forces Objects_Linked to be False too.
if In_Tree.Languages_Data.Table
(Lang_Index).Config.Object_Generated
then
In_Tree.Languages_Data.Table
(Lang_Index).Config.Objects_Linked :=
Value;
end if;
exception
when Constraint_Error =>
Error_Msg
(Project,
In_Tree,
"invalid value """
& Get_Name_String (Element.Value.Value)
& """ for Objects_Linked",
Element.Value.Location);
end;
when others => when others =>
null; null;
end case; end case;
...@@ -2661,6 +2764,139 @@ package body Prj.Nmsc is ...@@ -2661,6 +2764,139 @@ package body Prj.Nmsc is
end if; end if;
end Check_If_Externally_Built; end Check_If_Externally_Built;
----------------------
-- Check_Interfaces --
----------------------
procedure Check_Interfaces
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data)
is
Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Interfaces,
Data.Decl.Attributes,
In_Tree);
List : String_List_Id;
Element : String_Element;
Name : File_Name_Type;
Source : Source_Id;
Src_Data : Source_Data;
Project_2 : Project_Id;
Data_2 : Project_Data;
begin
if not Interfaces.Default then
-- Set In_Interfaces to False for all sources. It will be set to True
-- later for the sources in the Interfaces list.
Project_2 := Project;
Data_2 := Data;
loop
Source := Data_2.First_Source;
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
Src_Data.In_Interfaces := False;
In_Tree.Sources.Table (Source) := Src_Data;
Source := Src_Data.Next_In_Project;
end loop;
Project_2 := Data_2.Extends;
exit when Project_2 = No_Project;
Data_2 := In_Tree.Projects.Table (Project_2);
end loop;
List := Interfaces.Values;
while List /= Nil_String loop
Element := In_Tree.String_Elements.Table (List);
Get_Name_String (Element.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
Project_2 := Project;
Data_2 := Data;
Big_Loop :
loop
Source := Data_2.First_Source;
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
if Src_Data.File = Name then
if not Src_Data.Locally_Removed then
In_Tree.Sources.Table (Source).In_Interfaces := True;
In_Tree.Sources.Table
(Source).Declared_In_Interfaces := True;
if Src_Data.Other_Part /= No_Source then
In_Tree.Sources.Table
(Src_Data.Other_Part).In_Interfaces := True;
In_Tree.Sources.Table
(Src_Data.Other_Part).Declared_In_Interfaces :=
True;
end if;
if Current_Verbosity = High then
Write_Str (" interface: ");
Write_Line (Get_Name_String (Src_Data.Path));
end if;
end if;
exit Big_Loop;
end if;
Source := Src_Data.Next_In_Project;
end loop;
Project_2 := Data_2.Extends;
exit Big_Loop when Project_2 = No_Project;
Data_2 := In_Tree.Projects.Table (Project_2);
end loop Big_Loop;
if Source = No_Source then
Error_Msg_File_1 := File_Name_Type (Element.Value);
Error_Msg_Name_1 := Data.Name;
Error_Msg
(Project,
In_Tree,
"{ cannot be an interface of project %% " &
"as it is not one of its sources",
Element.Location);
end if;
List := Element.Next;
end loop;
Data.Interfaces_Defined := True;
elsif Data.Extends /= No_Project then
Data.Interfaces_Defined :=
In_Tree.Projects.Table (Data.Extends).Interfaces_Defined;
if Data.Interfaces_Defined then
Source := Data.First_Source;
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
if not Src_Data.Declared_In_Interfaces then
Src_Data.In_Interfaces := False;
In_Tree.Sources.Table (Source) := Src_Data;
end if;
Source := Src_Data.Next_In_Project;
end loop;
end if;
end if;
end Check_Interfaces;
-------------------------- --------------------------
-- Check_Naming_Schemes -- -- Check_Naming_Schemes --
-------------------------- --------------------------
...@@ -3616,17 +3852,17 @@ package body Prj.Nmsc is ...@@ -3616,17 +3852,17 @@ package body Prj.Nmsc is
"library project %% cannot extend project %% " & "library project %% cannot extend project %% " &
"that is not a library project", "that is not a library project",
Data.Location); Data.Location);
Continuation := Continuation_String'Access;
else elsif Data.Library_Kind /= Static then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
Continuation.all & Continuation.all &
"library project %% cannot import project %% " & "shared library project %% cannot import project %% " &
"that is not a library project", "that is not a shared library project",
Data.Location); Data.Location);
Continuation := Continuation_String'Access;
end if; end if;
Continuation := Continuation_String'Access;
end if; end if;
elsif Data.Library_Kind /= Static and then elsif Data.Library_Kind /= Static and then
...@@ -5525,11 +5761,12 @@ package body Prj.Nmsc is ...@@ -5525,11 +5761,12 @@ package body Prj.Nmsc is
if Msg (First) = '\' then if Msg (First) = '\' then
First := First + 1; First := First + 1;
end if;
-- Warning character is always the first one in this package -- Warning character is always the first one in this package
-- this is an undocumented kludge??? -- this is an undocumented kludge???
elsif Msg (First) = '?' then if Msg (First) = '?' then
First := First + 1; First := First + 1;
Add ("Warning: "); Add ("Warning: ");
...@@ -7364,7 +7601,9 @@ package body Prj.Nmsc is ...@@ -7364,7 +7601,9 @@ package body Prj.Nmsc is
end loop; end loop;
-- In Multi_Language mode, check whether the file is -- In Multi_Language mode, check whether the file is
-- already there (??? Is this really needed, and why ?) -- already there: the same file name may be in the list; if
-- the source is missing, the error will be on the first
-- mention of the source file name.
case Get_Mode is case Get_Mode is
when Ada_Only => when Ada_Only =>
...@@ -7475,6 +7714,62 @@ package body Prj.Nmsc is ...@@ -7475,6 +7714,62 @@ package body Prj.Nmsc is
(Project, In_Tree, Data, (Project, In_Tree, Data,
For_All_Sources => For_All_Sources =>
Sources.Default and then Source_List_File.Default); Sources.Default and then Source_List_File.Default);
-- Check if all exceptions have been found.
-- For Ada, it is an error if an exception is not found.
-- For other language, the source is removed.
declare
Source : Source_Id;
Src_Data : Source_Data;
begin
Source := Data.First_Source;
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
if Src_Data.Naming_Exception
and then Src_Data.Path = No_Path
then
if Src_Data.Unit /= No_Name then
Error_Msg_Name_1 := Name_Id (Src_Data.Display_File);
Error_Msg_Name_2 := Name_Id (Src_Data.Unit);
Error_Msg
(Project, In_Tree,
"source file %% for unit %% not found",
No_Location);
else
Remove_Source
(Source, No_Source, Project, Data, In_Tree);
end if;
end if;
Source := Src_Data.Next_In_Project;
end loop;
end;
-- Check that all sources in Source_Files or the file
-- Source_List_File has been found.
declare
Name_Loc : Name_Location;
begin
Name_Loc := Source_Names.Get_First;
while Name_Loc /= No_Name_Location loop
if (not Name_Loc.Except) and then (not Name_Loc.Found) then
Error_Msg_Name_1 := Name_Id (Name_Loc.Name);
Error_Msg
(Project,
In_Tree,
"file %% not found",
Name_Loc.Location);
end if;
Name_Loc := Source_Names.Get_Next;
end loop;
end;
end if; end if;
if Get_Mode = Ada_Only if Get_Mode = Ada_Only
...@@ -7496,12 +7791,12 @@ package body Prj.Nmsc is ...@@ -7496,12 +7791,12 @@ package body Prj.Nmsc is
------------------------------------------- -------------------------------------------
procedure Get_Path_Names_And_Record_Ada_Sources procedure Get_Path_Names_And_Record_Ada_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
Current_Dir : String) Current_Dir : String)
is is
Source_Dir : String_List_Id := Data.Source_Dirs; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
Path : Path_Name_Type; Path : Path_Name_Type;
Dir : Dir_Type; Dir : Dir_Type;
...@@ -7515,9 +7810,10 @@ package body Prj.Nmsc is ...@@ -7515,9 +7810,10 @@ package body Prj.Nmsc is
Source_Recorded : Boolean := False; Source_Recorded : Boolean := False;
begin begin
-- We look in all source directories for the file names in the -- We look in all source directories for the file names in the hash
-- hash table Source_Names -- table Source_Names.
Source_Dir := Data.Source_Dirs;
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
Source_Recorded := False; Source_Recorded := False;
Element := In_Tree.String_Elements.Table (Source_Dir); Element := In_Tree.String_Elements.Table (Source_Dir);
...@@ -8042,6 +8338,7 @@ package body Prj.Nmsc is ...@@ -8042,6 +8338,7 @@ package body Prj.Nmsc is
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language; Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
Language : Language_Index; Language : Language_Index;
Source : Source_Id; Source : Source_Id;
Other_Part : Source_Id;
Add_Src : Boolean; Add_Src : Boolean;
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
Src_Data : Source_Data; Src_Data : Source_Data;
...@@ -8084,6 +8381,8 @@ package body Prj.Nmsc is ...@@ -8084,6 +8381,8 @@ package body Prj.Nmsc is
else else
Name_Loc.Found := True; Name_Loc.Found := True;
Source_Names.Set (File_Name, Name_Loc);
if Name_Loc.Source = No_Source then if Name_Loc.Source = No_Source then
Check_Name := True; Check_Name := True;
...@@ -8115,6 +8414,8 @@ package body Prj.Nmsc is ...@@ -8115,6 +8414,8 @@ package body Prj.Nmsc is
end if; end if;
if Check_Name then if Check_Name then
Other_Part := No_Source;
Check_Naming_Schemes Check_Naming_Schemes
(In_Tree => In_Tree, (In_Tree => In_Tree,
Data => Data, Data => Data,
...@@ -8149,11 +8450,16 @@ package body Prj.Nmsc is ...@@ -8149,11 +8450,16 @@ package body Prj.Nmsc is
while Source /= No_Source loop while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source); Src_Data := In_Tree.Sources.Table (Source);
if (Unit /= No_Name if Unit /= No_Name
and then Src_Data.Unit = Unit and then Src_Data.Unit = Unit
and then Src_Data.Kind = Kind) and then Src_Data.Kind /= Kind
or else (Unit = No_Name then
and then Src_Data.File = File_Name) Other_Part := Source;
elsif (Unit /= No_Name
and then Src_Data.Unit = Unit
and then Src_Data.Kind = Kind)
or else (Unit = No_Name and then Src_Data.File = File_Name)
then then
-- Duplication of file/unit in same project is only -- Duplication of file/unit in same project is only
-- allowed if order of source directories is known. -- allowed if order of source directories is known.
...@@ -8165,17 +8471,13 @@ package body Prj.Nmsc is ...@@ -8165,17 +8471,13 @@ package body Prj.Nmsc is
elsif Unit /= No_Name then elsif Unit /= No_Name then
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree, "duplicate unit %%", No_Location);
"duplicate unit %%",
No_Location);
Add_Src := False; Add_Src := False;
else else
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree, "duplicate source file name {",
"duplicate source file " &
"name {",
No_Location); No_Location);
Add_Src := False; Add_Src := False;
end if; end if;
...@@ -8203,17 +8505,13 @@ package body Prj.Nmsc is ...@@ -8203,17 +8505,13 @@ package body Prj.Nmsc is
Error_Msg_Name_1 := In_Tree.Projects.Table (Project).Name; Error_Msg_Name_1 := In_Tree.Projects.Table (Project).Name;
Error_Msg_Name_2 := Name_Id (Display_Path_Id); Error_Msg_Name_2 := Name_Id (Display_Path_Id);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree, "\ project %%, %%", No_Location);
"\ project %%, %%",
No_Location);
Error_Msg_Name_1 := Error_Msg_Name_1 :=
In_Tree.Projects.Table (Src_Data.Project).Name; In_Tree.Projects.Table (Src_Data.Project).Name;
Error_Msg_Name_2 := Name_Id (Src_Data.Display_Path); Error_Msg_Name_2 := Name_Id (Src_Data.Display_Path);
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree, "\ project %%, %%", No_Location);
"\ project %%, %%",
No_Location);
Add_Src := False; Add_Src := False;
end if; end if;
...@@ -8235,6 +8533,7 @@ package body Prj.Nmsc is ...@@ -8235,6 +8533,7 @@ package body Prj.Nmsc is
Alternate_Languages => Alternate_Languages, Alternate_Languages => Alternate_Languages,
File_Name => File_Name, File_Name => File_Name,
Display_File => Display_File_Name, Display_File => Display_File_Name,
Other_Part => Other_Part,
Unit => Unit, Unit => Unit,
Path => Path_Id, Path => Path_Id,
Display_Path => Display_Path_Id, Display_Path => Display_Path_Id,
...@@ -8249,10 +8548,10 @@ package body Prj.Nmsc is ...@@ -8249,10 +8548,10 @@ package body Prj.Nmsc is
------------------------ ------------------------
procedure Search_Directories procedure Search_Directories
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
For_All_Sources : Boolean) For_All_Sources : Boolean)
is is
Source_Dir : String_List_Id; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
...@@ -8278,11 +8577,12 @@ package body Prj.Nmsc is ...@@ -8278,11 +8577,12 @@ package body Prj.Nmsc is
declare declare
Source_Directory : constant String := Source_Directory : constant String :=
Name_Buffer (1 .. Name_Len) & Name_Buffer (1 .. Name_Len) &
Directory_Separator; Directory_Separator;
Dir_Last : constant Natural :=
Compute_Directory_Last Dir_Last : constant Natural :=
(Source_Directory); Compute_Directory_Last
(Source_Directory);
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -8302,6 +8602,7 @@ package body Prj.Nmsc is ...@@ -8302,6 +8602,7 @@ package body Prj.Nmsc is
-- ??? Duplicate system call here, we just did a -- ??? Duplicate system call here, we just did a
-- a similar one. Maybe Ada.Directories would be more -- a similar one. Maybe Ada.Directories would be more
-- appropriate here -- appropriate here
if Is_Regular_File if Is_Regular_File
(Source_Directory & Name (1 .. Last)) (Source_Directory & Name (1 .. Last))
then then
...@@ -8324,7 +8625,7 @@ package body Prj.Nmsc is ...@@ -8324,7 +8625,7 @@ package body Prj.Nmsc is
declare declare
FF : File_Found := FF : File_Found :=
Excluded_Sources_Htable.Get (File_Name); Excluded_Sources_Htable.Get (File_Name);
begin begin
if FF /= No_File_Found then if FF /= No_File_Found then
...@@ -8364,6 +8665,7 @@ package body Prj.Nmsc is ...@@ -8364,6 +8665,7 @@ package body Prj.Nmsc is
when Directory_Error => when Directory_Error =>
null; null;
end; end;
Source_Dir := Element.Next; Source_Dir := Element.Next;
end loop; end loop;
...@@ -8377,10 +8679,10 @@ package body Prj.Nmsc is ...@@ -8377,10 +8679,10 @@ package body Prj.Nmsc is
---------------------- ----------------------
procedure Look_For_Sources procedure Look_For_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : in out Project_Data; Data : in out Project_Data;
Current_Dir : String) Current_Dir : String)
is is
procedure Remove_Locally_Removed_Files_From_Units; procedure Remove_Locally_Removed_Files_From_Units;
-- Mark all locally removed sources as such in the Units table -- Mark all locally removed sources as such in the Units table
...@@ -8396,11 +8698,13 @@ package body Prj.Nmsc is ...@@ -8396,11 +8698,13 @@ package body Prj.Nmsc is
--------------------------------------------- ---------------------------------------------
procedure Remove_Locally_Removed_Files_From_Units is procedure Remove_Locally_Removed_Files_From_Units is
Excluded : File_Found := Excluded_Sources_Htable.Get_First; Excluded : File_Found;
OK : Boolean; OK : Boolean;
Unit : Unit_Data; Unit : Unit_Data;
Extended : Project_Id; Extended : Project_Id;
begin begin
Excluded := Excluded_Sources_Htable.Get_First;
while Excluded /= No_File_Found loop while Excluded /= No_File_Found loop
OK := False; OK := False;
...@@ -8513,9 +8817,9 @@ package body Prj.Nmsc is ...@@ -8513,9 +8817,9 @@ package body Prj.Nmsc is
File_Id := Name_Find; File_Id := Name_Find;
end if; end if;
-- Put each naming exception in the Source_Names -- Put each naming exception in the Source_Names hash
-- hash table, but if there are repetition, don't -- table, but if there are repetition, don't bother
-- bother after the first instance. -- after the first instance.
if Source_Names.Get (File_Id) = No_Name_Location then if Source_Names.Get (File_Id) = No_Name_Location then
Source_Found := True; Source_Found := True;
...@@ -8564,17 +8868,18 @@ package body Prj.Nmsc is ...@@ -8564,17 +8868,18 @@ package body Prj.Nmsc is
-------------------------------------------- --------------------------------------------
procedure Process_Sources_In_Multi_Language_Mode is procedure Process_Sources_In_Multi_Language_Mode is
Source : Source_Id := Data.First_Source; Source : Source_Id;
Src_Data : Source_Data; Src_Data : Source_Data;
Name_Loc : Name_Location; Name_Loc : Name_Location;
OK : Boolean; OK : Boolean;
FF : File_Found; FF : File_Found;
begin begin
-- First, put all the naming exceptions, if any, in the Source_Names -- First, put all naming exceptions if any, in the Source_Names table
-- table.
Unit_Exceptions.Reset; Unit_Exceptions.Reset;
Source := Data.First_Source;
while Source /= No_Source loop while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source); Src_Data := In_Tree.Sources.Table (Source);
...@@ -8585,8 +8890,7 @@ package body Prj.Nmsc is ...@@ -8585,8 +8890,7 @@ package body Prj.Nmsc is
then then
Error_Msg_File_1 := Src_Data.File; Error_Msg_File_1 := Src_Data.File;
Error_Msg Error_Msg
(Project, (Project, In_Tree,
In_Tree,
"{ cannot be both excluded and an exception file name", "{ cannot be both excluded and an exception file name",
No_Location); No_Location);
end if; end if;
...@@ -8612,7 +8916,7 @@ package body Prj.Nmsc is ...@@ -8612,7 +8916,7 @@ package body Prj.Nmsc is
if Src_Data.Unit /= No_Name then if Src_Data.Unit /= No_Name then
declare declare
Unit_Except : Unit_Exception := Unit_Except : Unit_Exception :=
Unit_Exceptions.Get (Src_Data.Unit); Unit_Exceptions.Get (Src_Data.Unit);
begin begin
Unit_Except.Name := Src_Data.Unit; Unit_Except.Name := Src_Data.Unit;
...@@ -8634,7 +8938,6 @@ package body Prj.Nmsc is ...@@ -8634,7 +8938,6 @@ package body Prj.Nmsc is
(Ada_Language_Index, Current_Dir, Project, In_Tree, Data); (Ada_Language_Index, Current_Dir, Project, In_Tree, Data);
FF := Excluded_Sources_Htable.Get_First; FF := Excluded_Sources_Htable.Get_First;
while FF /= No_File_Found loop while FF /= No_File_Found loop
OK := False; OK := False;
Source := In_Tree.First_Source; Source := In_Tree.First_Source;
...@@ -8644,13 +8947,14 @@ package body Prj.Nmsc is ...@@ -8644,13 +8947,14 @@ package body Prj.Nmsc is
if Src_Data.File = FF.File then if Src_Data.File = FF.File then
-- Check that this is from this project or a -- Check that this is from this project or a project that
-- project that the current project extends. -- the current project extends.
if Src_Data.Project = Project or else if Src_Data.Project = Project or else
Is_Extending (Project, Src_Data.Project, In_Tree) Is_Extending (Project, Src_Data.Project, In_Tree)
then then
Src_Data.Locally_Removed := True; Src_Data.Locally_Removed := True;
Src_Data.In_Interfaces := False;
In_Tree.Sources.Table (Source) := Src_Data; In_Tree.Sources.Table (Source) := Src_Data;
Add_Forbidden_File_Name (FF.File); Add_Forbidden_File_Name (FF.File);
OK := True; OK := True;
...@@ -8772,6 +9076,7 @@ package body Prj.Nmsc is ...@@ -8772,6 +9076,7 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref) return Boolean In_Tree : Project_Tree_Ref) return Boolean
is is
Current : Project_Id := Extending; Current : Project_Id := Extending;
begin begin
loop loop
if Current = No_Project then if Current = No_Project then
...@@ -8830,11 +9135,11 @@ package body Prj.Nmsc is ...@@ -8830,11 +9135,11 @@ package body Prj.Nmsc is
declare declare
Canonical_Path : constant String := Canonical_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Get_Name_String (Path_Name), (Get_Name_String (Path_Name),
Directory => Current_Dir, Directory => Current_Dir,
Resolve_Links => Opt.Follow_Links_For_Files, Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => False); Case_Sensitive => False);
begin begin
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Canonical_Path); Add_Str_To_Name_Buffer (Canonical_Path);
...@@ -8854,8 +9159,8 @@ package body Prj.Nmsc is ...@@ -8854,8 +9159,8 @@ package body Prj.Nmsc is
Unit_Kind => Unit_Kind, Unit_Kind => Unit_Kind,
Needs_Pragma => Needs_Pragma); Needs_Pragma => Needs_Pragma);
if Exception_Id = No_Ada_Naming_Exception and then if Exception_Id = No_Ada_Naming_Exception
Unit_Name = No_Name and then Unit_Name = No_Name
then then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" """); Write_Str (" """);
...@@ -8902,31 +9207,27 @@ package body Prj.Nmsc is ...@@ -8902,31 +9207,27 @@ package body Prj.Nmsc is
-- Put the file name in the list of sources of the project -- Put the file name in the list of sources of the project
String_Element_Table.Increment_Last String_Element_Table.Increment_Last (In_Tree.String_Elements);
(In_Tree.String_Elements);
In_Tree.String_Elements.Table In_Tree.String_Elements.Table
(String_Element_Table.Last (String_Element_Table.Last (In_Tree.String_Elements)) :=
(In_Tree.String_Elements)) := (Value => Name_Id (Canonical_File_Name),
(Value => Name_Id (Canonical_File_Name), Display_Value => Name_Id (File_Name),
Display_Value => Name_Id (File_Name), Location => No_Location,
Location => No_Location, Flag => False,
Flag => False, Next => Nil_String,
Next => Nil_String, Index => Unit_Ind);
Index => Unit_Ind);
if Current_Source = Nil_String then if Current_Source = Nil_String then
Data.Ada_Sources := String_Element_Table.Last Data.Ada_Sources :=
(In_Tree.String_Elements); String_Element_Table.Last (In_Tree.String_Elements);
Data.Sources := Data.Ada_Sources; Data.Sources := Data.Ada_Sources;
else else
In_Tree.String_Elements.Table In_Tree.String_Elements.Table (Current_Source).Next :=
(Current_Source).Next := String_Element_Table.Last (In_Tree.String_Elements);
String_Element_Table.Last
(In_Tree.String_Elements);
end if; end if;
Current_Source := String_Element_Table.Last Current_Source :=
(In_Tree.String_Elements); String_Element_Table.Last (In_Tree.String_Elements);
-- Put the unit in unit list -- Put the unit in unit list
...@@ -8951,9 +9252,9 @@ package body Prj.Nmsc is ...@@ -8951,9 +9252,9 @@ package body Prj.Nmsc is
The_Unit_Data := In_Tree.Units.Table (The_Unit); The_Unit_Data := In_Tree.Units.Table (The_Unit);
if (The_Unit_Data.File_Names (Unit_Kind).Name = if (The_Unit_Data.File_Names (Unit_Kind).Name =
Canonical_File_Name Canonical_File_Name
and then and then
The_Unit_Data.File_Names (Unit_Kind).Path = Slash) The_Unit_Data.File_Names (Unit_Kind).Path = Slash)
or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
or else Project_Extends or else Project_Extends
(Data.Extends, (Data.Extends,
...@@ -8981,21 +9282,21 @@ package body Prj.Nmsc is ...@@ -8981,21 +9282,21 @@ package body Prj.Nmsc is
Display_Path => Path_Name, Display_Path => Path_Name,
Project => Project, Project => Project,
Needs_Pragma => Needs_Pragma); Needs_Pragma => Needs_Pragma);
In_Tree.Units.Table (The_Unit) := In_Tree.Units.Table (The_Unit) := The_Unit_Data;
The_Unit_Data;
Source_Recorded := True; Source_Recorded := True;
elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
and then (Data.Known_Order_Of_Source_Dirs or else and then (Data.Known_Order_Of_Source_Dirs
The_Unit_Data.File_Names (Unit_Kind).Path = or else
Canonical_Path_Name) The_Unit_Data.File_Names (Unit_Kind).Path =
Canonical_Path_Name)
then then
if Previous_Source = Nil_String then if Previous_Source = Nil_String then
Data.Ada_Sources := Nil_String; Data.Ada_Sources := Nil_String;
Data.Sources := Nil_String; Data.Sources := Nil_String;
else else
In_Tree.String_Elements.Table In_Tree.String_Elements.Table (Previous_Source).Next :=
(Previous_Source).Next := Nil_String; Nil_String;
String_Element_Table.Decrement_Last String_Element_Table.Decrement_Last
(In_Tree.String_Elements); (In_Tree.String_Elements);
end if; end if;
...@@ -9008,8 +9309,7 @@ package body Prj.Nmsc is ...@@ -9008,8 +9309,7 @@ package body Prj.Nmsc is
if The_Location = No_Location then if The_Location = No_Location then
The_Location := The_Location :=
In_Tree.Projects.Table In_Tree.Projects.Table (Project).Location;
(Project).Location;
end if; end if;
Err_Vars.Error_Msg_Name_1 := Unit_Name; Err_Vars.Error_Msg_Name_1 := Unit_Name;
...@@ -9039,20 +9339,18 @@ package body Prj.Nmsc is ...@@ -9039,20 +9339,18 @@ package body Prj.Nmsc is
else else
-- First, check if there is no other unit with this file -- First, check if there is no other unit with this file
-- name in another project. If it is, report an error. -- name in another project. If it is, report error but note
-- Of course, we do that only for the first unit in the -- we do that only for the first unit in the source file.
-- source file.
Unit_Prj := Files_Htable.Get Unit_Prj :=
(In_Tree.Files_HT, Canonical_File_Name); Files_Htable.Get (In_Tree.Files_HT, Canonical_File_Name);
if not File_Name_Recorded and then if not File_Name_Recorded and then
Unit_Prj /= No_Unit_Project Unit_Prj /= No_Unit_Project
then then
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg_Name_1 := Error_Msg_Name_1 :=
In_Tree.Projects.Table In_Tree.Projects.Table (Unit_Prj.Project).Name;
(Unit_Prj.Project).Name;
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"{ is already a source of project %%", "{ is already a source of project %%",
...@@ -9077,8 +9375,7 @@ package body Prj.Nmsc is ...@@ -9077,8 +9375,7 @@ package body Prj.Nmsc is
Display_Path => Path_Name, Display_Path => Path_Name,
Project => Project, Project => Project,
Needs_Pragma => Needs_Pragma); Needs_Pragma => Needs_Pragma);
In_Tree.Units.Table (The_Unit) := In_Tree.Units.Table (The_Unit) := The_Unit_Data;
The_Unit_Data;
Source_Recorded := True; Source_Recorded := True;
end if; end if;
end if; end if;
...@@ -9129,7 +9426,6 @@ package body Prj.Nmsc is ...@@ -9129,7 +9426,6 @@ package body Prj.Nmsc is
if Naming_Exceptions then if Naming_Exceptions then
Write_Str ("naming exceptions"); Write_Str ("naming exceptions");
else else
Write_Str ("sources"); Write_Str ("sources");
end if; end if;
...@@ -9205,15 +9501,13 @@ package body Prj.Nmsc is ...@@ -9205,15 +9501,13 @@ package body Prj.Nmsc is
if First_Error then if First_Error then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree, "source file { cannot be found",
"source file { cannot be found",
NL.Location); NL.Location);
First_Error := False; First_Error := False;
else else
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree, "\source file { cannot be found",
"\source file { cannot be found",
NL.Location); NL.Location);
end if; end if;
end if; end if;
...@@ -9225,11 +9519,13 @@ package body Prj.Nmsc is ...@@ -9225,11 +9519,13 @@ package body Prj.Nmsc is
-- of sources must be removed. -- of sources must be removed.
declare declare
Source_Id : Other_Source_Id := Data.First_Other_Source; Source_Id : Other_Source_Id;
Prev_Id : Other_Source_Id := No_Other_Source; Prev_Id : Other_Source_Id;
Source : Other_Source; Source : Other_Source;
begin begin
Prev_Id := No_Other_Source;
Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop while Source_Id /= No_Other_Source loop
Source := In_Tree.Other_Sources.Table (Source_Id); Source := In_Tree.Other_Sources.Table (Source_Id);
...@@ -9245,10 +9541,8 @@ package body Prj.Nmsc is ...@@ -9245,10 +9541,8 @@ package body Prj.Nmsc is
if Prev_Id = No_Other_Source then if Prev_Id = No_Other_Source then
Data.First_Other_Source := Source.Next; Data.First_Other_Source := Source.Next;
else else
In_Tree.Other_Sources.Table In_Tree.Other_Sources.Table (Prev_Id).Next := Source.Next;
(Prev_Id).Next := Source.Next;
end if; end if;
Source_Id := Source.Next; Source_Id := Source.Next;
...@@ -9278,7 +9572,6 @@ package body Prj.Nmsc is ...@@ -9278,7 +9572,6 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
is is
Src_Data : constant Source_Data := In_Tree.Sources.Table (Id); Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
Source : Source_Id; Source : Source_Id;
begin begin
...@@ -9287,7 +9580,11 @@ package body Prj.Nmsc is ...@@ -9287,7 +9580,11 @@ package body Prj.Nmsc is
Write_Line (Id'Img); Write_Line (Id'Img);
end if; end if;
In_Tree.Sources.Table (Id).Replaced_By := Replaced_By; if Replaced_By /= No_Source then
In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
In_Tree.Sources.Table (Replaced_By).Declared_In_Interfaces :=
In_Tree.Sources.Table (Id).Declared_In_Interfaces;
end if;
-- Remove the source from the global source list -- Remove the source from the global source list
...@@ -9379,10 +9676,11 @@ package body Prj.Nmsc is ...@@ -9379,10 +9676,11 @@ package body Prj.Nmsc is
----------------------- -----------------------
procedure Report_No_Sources procedure Report_No_Sources
(Project : Project_Id; (Project : Project_Id;
Lang_Name : String; Lang_Name : String;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Location : Source_Ptr) Location : Source_Ptr;
Continuation : Boolean := False)
is is
begin begin
case When_No_Sources is case When_No_Sources is
...@@ -9390,11 +9688,24 @@ package body Prj.Nmsc is ...@@ -9390,11 +9688,24 @@ package body Prj.Nmsc is
null; null;
when Warning | Error => when Warning | Error =>
Error_Msg_Warn := When_No_Sources = Warning; declare
Error_Msg Msg : constant String :=
(Project, In_Tree, "<there are no " &
"<there are no " & Lang_Name & " sources in this project", Lang_Name &
Location); " sources in this project";
begin
Error_Msg_Warn := When_No_Sources = Warning;
if Continuation then
Error_Msg
(Project, In_Tree, "\" & Msg, Location);
else
Error_Msg
(Project, In_Tree, Msg, Location);
end if;
end;
end case; end case;
end Report_No_Sources; end Report_No_Sources;
...@@ -9438,6 +9749,7 @@ package body Prj.Nmsc is ...@@ -9438,6 +9749,7 @@ package body Prj.Nmsc is
Src_Index => 0, Src_Index => 0,
In_Array => Naming.Body_Suffix, In_Array => Naming.Body_Suffix,
In_Tree => In_Tree); In_Tree => In_Tree);
begin begin
-- If no suffix for this language in package Naming, use the default -- If no suffix for this language in package Naming, use the default
...@@ -9481,29 +9793,25 @@ package body Prj.Nmsc is ...@@ -9481,29 +9793,25 @@ package body Prj.Nmsc is
Specs : Boolean; Specs : Boolean;
Extending : Boolean) Extending : Boolean)
is is
Conv : Array_Element_Id := Conventions; Conv : Array_Element_Id;
Unit : Name_Id; Unit : Name_Id;
The_Unit_Id : Unit_Index; The_Unit_Id : Unit_Index;
The_Unit_Data : Unit_Data; The_Unit_Data : Unit_Data;
Location : Source_Ptr; Location : Source_Ptr;
begin begin
Conv := Conventions;
while Conv /= No_Array_Element loop while Conv /= No_Array_Element loop
Unit := In_Tree.Array_Elements.Table (Conv).Index; Unit := In_Tree.Array_Elements.Table (Conv).Index;
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
Get_Name_String (Unit); Get_Name_String (Unit);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Unit := Name_Find; Unit := Name_Find;
The_Unit_Id := Units_Htable.Get The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
(In_Tree.Units_HT, Unit); Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
Location := In_Tree.Array_Elements.Table
(Conv).Value.Location;
if The_Unit_Id = No_Unit_Index then if The_Unit_Id = No_Unit_Index then
Error_Msg Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
(Project, In_Tree,
"?unknown unit %%",
Location);
else else
The_Unit_Data := In_Tree.Units.Table (The_Unit_Id); The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
......
gcc/ada/prj-pars.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -70,7 +70,7 @@ package body Prj.Pars is ...@@ -70,7 +70,7 @@ package body Prj.Pars is
-- If there were no error, process the tree -- If there were no error, process the tree
if Project_Node /= Empty_Node then if Present (Project_Node) then
Prj.Proc.Process Prj.Proc.Process
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => The_Project, Project => The_Project,
......
gcc/ada/prj-part.adb
...@@ -333,7 +333,8 @@ package body Prj.Part is ...@@ -333,7 +333,8 @@ package body Prj.Part is
E => (Name => Virtual_Name_Id, E => (Name => Virtual_Name_Id,
Node => Virtual_Project, Node => Virtual_Project,
Canonical_Path => No_Path, Canonical_Path => No_Path,
Extended => False)); Extended => False,
Proj_Qualifier => Unspecified));
end Create_Virtual_Extending_Project; end Create_Virtual_Extending_Project;
---------------------------- ----------------------------
...@@ -396,21 +397,21 @@ package body Prj.Part is ...@@ -396,21 +397,21 @@ package body Prj.Part is
-- Nothing to do if Proj is not defined or if it has already been -- Nothing to do if Proj is not defined or if it has already been
-- processed. -- processed.
if Proj /= Empty_Node and then not Processed_Hash.Get (Proj) then if Present (Proj) and then not Processed_Hash.Get (Proj) then
-- Make sure the project will not be processed again -- Make sure the project will not be processed again
Processed_Hash.Set (Proj, True); Processed_Hash.Set (Proj, True);
Declaration := Project_Declaration_Of (Proj, In_Tree); Declaration := Project_Declaration_Of (Proj, In_Tree);
if Declaration /= Empty_Node then if Present (Declaration) then
Extended := Extended_Project_Of (Declaration, In_Tree); Extended := Extended_Project_Of (Declaration, In_Tree);
end if; end if;
-- If this is a project that may need a virtual extending project -- If this is a project that may need a virtual extending project
-- and it is not itself an extending project, put it in the list. -- and it is not itself an extending project, put it in the list.
if Potentially_Virtual and then Extended = Empty_Node then if Potentially_Virtual and then No (Extended) then
Virtual_Hash.Set (Proj, Proj); Virtual_Hash.Set (Proj, Proj);
end if; end if;
...@@ -418,10 +419,10 @@ package body Prj.Part is ...@@ -418,10 +419,10 @@ package body Prj.Part is
With_Clause := First_With_Clause_Of (Proj, In_Tree); With_Clause := First_With_Clause_Of (Proj, In_Tree);
while With_Clause /= Empty_Node loop while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree); Imported := Project_Node_Of (With_Clause, In_Tree);
if Imported /= Empty_Node then if Present (Imported) then
Look_For_Virtual_Projects_For Look_For_Virtual_Projects_For
(Imported, In_Tree, Potentially_Virtual => True); (Imported, In_Tree, Potentially_Virtual => True);
end if; end if;
...@@ -512,7 +513,7 @@ package body Prj.Part is ...@@ -512,7 +513,7 @@ package body Prj.Part is
-- virtual extending projects and check that there are no illegally -- virtual extending projects and check that there are no illegally
-- imported projects. -- imported projects.
if Project /= Empty_Node if Present (Project)
and then Is_Extending_All (Project, In_Tree) and then Is_Extending_All (Project, In_Tree)
then then
-- First look for projects that potentially need a virtual -- First look for projects that potentially need a virtual
...@@ -549,10 +550,10 @@ package body Prj.Part is ...@@ -549,10 +550,10 @@ package body Prj.Part is
begin begin
With_Clause := First_With_Clause_Of (Project, In_Tree); With_Clause := First_With_Clause_Of (Project, In_Tree);
while With_Clause /= Empty_Node loop while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree); Imported := Project_Node_Of (With_Clause, In_Tree);
if Imported /= Empty_Node then if Present (Imported) then
Declaration := Project_Declaration_Of (Imported, In_Tree); Declaration := Project_Declaration_Of (Imported, In_Tree);
if Extended_Project_Of (Declaration, In_Tree) /= if Extended_Project_Of (Declaration, In_Tree) /=
...@@ -561,7 +562,7 @@ package body Prj.Part is ...@@ -561,7 +562,7 @@ package body Prj.Part is
loop loop
Imported := Imported :=
Extended_Project_Of (Declaration, In_Tree); Extended_Project_Of (Declaration, In_Tree);
exit when Imported = Empty_Node; exit when No (Imported);
Virtual_Hash.Remove (Imported); Virtual_Hash.Remove (Imported);
Declaration := Declaration :=
Project_Declaration_Of (Imported, In_Tree); Project_Declaration_Of (Imported, In_Tree);
...@@ -578,7 +579,7 @@ package body Prj.Part is ...@@ -578,7 +579,7 @@ package body Prj.Part is
declare declare
Proj : Project_Node_Id := Virtual_Hash.Get_First; Proj : Project_Node_Id := Virtual_Hash.Get_First;
begin begin
while Proj /= Empty_Node loop while Present (Proj) loop
Create_Virtual_Extending_Project (Proj, Project, In_Tree); Create_Virtual_Extending_Project (Proj, Project, In_Tree);
Proj := Virtual_Hash.Get_Next; Proj := Virtual_Hash.Get_Next;
end loop; end loop;
...@@ -592,7 +593,7 @@ package body Prj.Part is ...@@ -592,7 +593,7 @@ package body Prj.Part is
Project := Empty_Node; Project := Empty_Node;
end if; end if;
if Project = Empty_Node or else Always_Errout_Finalize then if No (Project) or else Always_Errout_Finalize then
Prj.Err.Finalize; Prj.Err.Finalize;
end if; end if;
end; end;
...@@ -738,9 +739,9 @@ package body Prj.Part is ...@@ -738,9 +739,9 @@ package body Prj.Part is
-- Set Current_Project to the last project in the current list, if the -- Set Current_Project to the last project in the current list, if the
-- list is not empty. -- list is not empty.
if Current_Project /= Empty_Node then if Present (Current_Project) then
while while
Next_With_Clause_Of (Current_Project, In_Tree) /= Empty_Node Present (Next_With_Clause_Of (Current_Project, In_Tree))
loop loop
Current_Project := Next_With_Clause_Of (Current_Project, In_Tree); Current_Project := Next_With_Clause_Of (Current_Project, In_Tree);
end loop; end loop;
...@@ -797,7 +798,7 @@ package body Prj.Part is ...@@ -797,7 +798,7 @@ package body Prj.Part is
Previous_Project := Current_Project; Previous_Project := Current_Project;
if Current_Project = Empty_Node then if No (Current_Project) then
-- First with clause of the context clause -- First with clause of the context clause
...@@ -848,7 +849,7 @@ package body Prj.Part is ...@@ -848,7 +849,7 @@ package body Prj.Part is
-- Parse the imported project, if its project id is unknown -- Parse the imported project, if its project id is unknown
if Withed_Project = Empty_Node then if No (Withed_Project) then
Parse_Single_Project Parse_Single_Project
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => Withed_Project, Project => Withed_Project,
...@@ -865,13 +866,13 @@ package body Prj.Part is ...@@ -865,13 +866,13 @@ package body Prj.Part is
Extends_All := Is_Extending_All (Withed_Project, In_Tree); Extends_All := Is_Extending_All (Withed_Project, In_Tree);
end if; end if;
if Withed_Project = Empty_Node then if No (Withed_Project) then
-- If parsing unsuccessful, remove the context clause -- If parsing unsuccessful, remove the context clause
Current_Project := Previous_Project; Current_Project := Previous_Project;
if Current_Project = Empty_Node then if No (Current_Project) then
Imported_Projects := Empty_Node; Imported_Projects := Empty_Node;
else else
...@@ -936,8 +937,11 @@ package body Prj.Part is ...@@ -936,8 +937,11 @@ package body Prj.Part is
Tree_Private_Part.Projects_Htable.Get_First Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT); (In_Tree.Projects_HT);
Name_From_Path : constant Name_Id := Project_Name_From (Path_Name); Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
Name_Of_Project : Name_Id := No_Name; Name_Of_Project : Name_Id := No_Name;
Duplicated : Boolean := False;
First_With : With_Id; First_With : With_Id;
Imported_Projects : Project_Node_Id := Empty_Node; Imported_Projects : Project_Node_Id := Empty_Node;
...@@ -1021,9 +1025,11 @@ package body Prj.Part is ...@@ -1021,9 +1025,11 @@ package body Prj.Part is
if Extended then if Extended then
if A_Project_Name_And_Node.Extended then if A_Project_Name_And_Node.Extended then
Error_Msg if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
("cannot extend the same project file several times", Error_Msg
Token_Ptr); ("cannot extend the same project file several times",
Token_Ptr);
end if;
else else
Error_Msg Error_Msg
("cannot extend an already imported project file", ("cannot extend an already imported project file",
...@@ -1092,7 +1098,7 @@ package body Prj.Part is ...@@ -1092,7 +1098,7 @@ package body Prj.Part is
Tree.Reset_State; Tree.Reset_State;
Scan (In_Tree); Scan (In_Tree);
if (not In_Configuration) and then (Name_From_Path = No_Name) then if not In_Configuration and then Name_From_Path = No_Name then
-- The project file name is not correct (no or bad extension, or not -- The project file name is not correct (no or bad extension, or not
-- following Ada identifier's syntax). -- following Ada identifier's syntax).
...@@ -1122,7 +1128,6 @@ package body Prj.Part is ...@@ -1122,7 +1128,6 @@ package body Prj.Part is
Project_Stack.Table (Project_Stack.Last).Id := Project; Project_Stack.Table (Project_Stack.Last).Id := Project;
Set_Directory_Of (Project, In_Tree, Project_Directory); Set_Directory_Of (Project, In_Tree, Project_Directory);
Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name); Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
-- Check if there is a qualifier before the reserved word "project" -- Check if there is a qualifier before the reserved word "project"
...@@ -1279,7 +1284,7 @@ package body Prj.Part is ...@@ -1279,7 +1284,7 @@ package body Prj.Part is
begin begin
-- Output a warning if the actual name is not the expected name -- Output a warning if the actual name is not the expected name
if (not In_Configuration) if not In_Configuration
and then (Name_From_Path /= No_Name) and then (Name_From_Path /= No_Name)
and then Expected_Name /= Name_From_Path and then Expected_Name /= Name_From_Path
then then
...@@ -1350,6 +1355,7 @@ package body Prj.Part is ...@@ -1350,6 +1355,7 @@ package body Prj.Part is
-- Report an error if we already have a project with this name -- Report an error if we already have a project with this name
if Project_Name /= No_Name then if Project_Name /= No_Name then
Duplicated := True;
Error_Msg_Name_1 := Project_Name; Error_Msg_Name_1 := Project_Name;
Error_Msg Error_Msg
("duplicate project name %%", ("duplicate project name %%",
...@@ -1358,19 +1364,6 @@ package body Prj.Part is ...@@ -1358,19 +1364,6 @@ package body Prj.Part is
Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree)); Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
Error_Msg Error_Msg
("\already in %%", Location_Of (Project, In_Tree)); ("\already in %%", Location_Of (Project, In_Tree));
else
-- Otherwise, add the name of the project to the hash table,
-- so that we can check that no other subsequent project
-- will have the same name.
Tree_Private_Part.Projects_Htable.Set
(T => In_Tree.Projects_HT,
K => Name_Of_Project,
E => (Name => Name_Of_Project,
Node => Project,
Canonical_Path => Canonical_Path_Name,
Extended => Extended));
end if; end if;
end; end;
end if; end if;
...@@ -1444,13 +1437,28 @@ package body Prj.Part is ...@@ -1444,13 +1437,28 @@ package body Prj.Part is
Current_Dir => Current_Dir); Current_Dir => Current_Dir);
end; end;
-- A project that extends an extending-all project is also if Present (Extended_Project) then
-- an extending-all project.
-- A project that extends an extending-all project is
-- also an extending-all project.
if Is_Extending_All (Extended_Project, In_Tree) then
Set_Is_Extending_All (Project, In_Tree);
end if;
-- An abstract project can only extend an abstract
-- project, otherwise we may have an abstract project
-- with sources, if it inherits sources from the project
-- it extends.
if Extended_Project /= Empty_Node if Proj_Qualifier = Dry and then
and then Is_Extending_All (Extended_Project, In_Tree) Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
then then
Set_Is_Extending_All (Project, In_Tree); Error_Msg
("an abstract project can only extend " &
"another abstract project",
Qualifier_Location);
end if;
end if; end if;
end if; end if;
end; end;
...@@ -1470,7 +1478,7 @@ package body Prj.Part is ...@@ -1470,7 +1478,7 @@ package body Prj.Part is
begin begin
With_Clause_Loop : With_Clause_Loop :
while With_Clause /= Empty_Node loop while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree); Imported := Project_Node_Of (With_Clause, In_Tree);
if Is_Extending_All (With_Clause, In_Tree) then if Is_Extending_All (With_Clause, In_Tree) then
...@@ -1510,13 +1518,15 @@ package body Prj.Part is ...@@ -1510,13 +1518,15 @@ package body Prj.Part is
declare declare
Parent_Name : constant Name_Id := Name_Find; Parent_Name : constant Name_Id := Name_Find;
Parent_Found : Boolean := False; Parent_Found : Boolean := False;
Parent_Node : Project_Node_Id := Empty_Node;
With_Clause : Project_Node_Id := With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project, In_Tree); First_With_Clause_Of (Project, In_Tree);
begin begin
-- If there is an extended project, check its name -- If there is an extended project, check its name
if Extended_Project /= Empty_Node then if Present (Extended_Project) then
Parent_Node := Extended_Project;
Parent_Found := Parent_Found :=
Name_Of (Extended_Project, In_Tree) = Parent_Name; Name_Of (Extended_Project, In_Tree) = Parent_Name;
end if; end if;
...@@ -1524,16 +1534,18 @@ package body Prj.Part is ...@@ -1524,16 +1534,18 @@ package body Prj.Part is
-- If the parent project is not the extended project, -- If the parent project is not the extended project,
-- check each imported project until we find the parent project. -- check each imported project until we find the parent project.
while not Parent_Found and then With_Clause /= Empty_Node loop while not Parent_Found and then Present (With_Clause) loop
Parent_Found := Parent_Node := Project_Node_Of (With_Clause, In_Tree);
Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) = Parent_Found := Name_Of (Parent_Node, In_Tree) = Parent_Name;
Parent_Name;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop; end loop;
-- If the parent project was not found, report an error if Parent_Found then
Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
else
-- If the parent project was not found, report an error
if not Parent_Found then
Error_Msg_Name_1 := Name_Of_Project; Error_Msg_Name_1 := Name_Of_Project;
Error_Msg_Name_2 := Parent_Name; Error_Msg_Name_2 := Parent_Name;
Error_Msg ("project %% does not import or extend project %%", Error_Msg ("project %% does not import or extend project %%",
...@@ -1561,7 +1573,9 @@ package body Prj.Part is ...@@ -1561,7 +1573,9 @@ package body Prj.Part is
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check);
Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration); Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
if Extended_Project /= Empty_Node then if Present (Extended_Project)
and then Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
then
Set_Extending_Project_Of Set_Extending_Project_Of
(Project_Declaration_Of (Extended_Project, In_Tree), In_Tree, (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
To => Project); To => Project);
...@@ -1636,6 +1650,21 @@ package body Prj.Part is ...@@ -1636,6 +1650,21 @@ package body Prj.Part is
end if; end if;
end if; end if;
if not Duplicated and then Name_Of_Project /= No_Name then
-- Add the name of the project to the hash table, so that we can
-- check that no other subsequent project will have the same name.
Tree_Private_Part.Projects_Htable.Set
(T => In_Tree.Projects_HT,
K => Name_Of_Project,
E => (Name => Name_Of_Project,
Node => Project,
Canonical_Path => Canonical_Path_Name,
Extended => Extended,
Proj_Qualifier => Proj_Qualifier));
end if;
declare declare
From_Ext : Extension_Origin := None; From_Ext : Extension_Origin := None;
...@@ -1723,19 +1752,19 @@ package body Prj.Part is ...@@ -1723,19 +1752,19 @@ package body Prj.Part is
-- If we have a dot, check that it is followed by the correct extension -- If we have a dot, check that it is followed by the correct extension
if First > 0 and then Canonical (First) = '.' then if First > 0 and then Canonical (First) = '.' then
if ((not In_Configuration) and then if (not In_Configuration
Canonical (First .. Last) = Project_File_Extension and then and then Canonical (First .. Last) = Project_File_Extension
First /= 1) and then First /= 1)
or else or else
(In_Configuration and then (In_Configuration
Canonical (First .. Last) = Config_Project_File_Extension and then and then
First /= 1) Canonical (First .. Last) = Config_Project_File_Extension
and then First /= 1)
then then
-- Look for the last directory separator, if any -- Look for the last directory separator, if any
First := First - 1; First := First - 1;
Last := First; Last := First;
while First > 0 while First > 0
and then Canonical (First) /= '/' and then Canonical (First) /= '/'
and then Canonical (First) /= Dir_Sep and then Canonical (First) /= Dir_Sep
......
gcc/ada/prj-pp.adb
...@@ -319,13 +319,13 @@ package body Prj.PP is ...@@ -319,13 +319,13 @@ package body Prj.PP is
procedure Print (Node : Project_Node_Id; Indent : Natural) is procedure Print (Node : Project_Node_Id; Indent : Natural) is
begin begin
if Node /= Empty_Node then if Present (Node) then
case Kind_Of (Node, In_Tree) is case Kind_Of (Node, In_Tree) is
when N_Project => when N_Project =>
pragma Debug (Indicate_Tested (N_Project)); pragma Debug (Indicate_Tested (N_Project));
if First_With_Clause_Of (Node, In_Tree) /= Empty_Node then if Present (First_With_Clause_Of (Node, In_Tree)) then
-- with clause(s) -- with clause(s)
...@@ -424,7 +424,7 @@ package body Prj.PP is ...@@ -424,7 +424,7 @@ package body Prj.PP is
pragma Debug (Indicate_Tested (N_Project_Declaration)); pragma Debug (Indicate_Tested (N_Project_Declaration));
if if
First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node Present (First_Declarative_Item_Of (Node, In_Tree))
then then
Print Print
(First_Declarative_Item_Of (Node, In_Tree), (First_Declarative_Item_Of (Node, In_Tree),
...@@ -498,12 +498,12 @@ package body Prj.PP is ...@@ -498,12 +498,12 @@ package body Prj.PP is
First_Literal_String (Node, In_Tree); First_Literal_String (Node, In_Tree);
begin begin
while String_Node /= Empty_Node loop while Present (String_Node) loop
Output_String (String_Value_Of (String_Node, In_Tree)); Output_String (String_Value_Of (String_Node, In_Tree));
String_Node := String_Node :=
Next_Literal_String (String_Node, In_Tree); Next_Literal_String (String_Node, In_Tree);
if String_Node /= Empty_Node then if Present (String_Node) then
Write_String (", "); Write_String (", ");
end if; end if;
end loop; end loop;
...@@ -543,7 +543,44 @@ package body Prj.PP is ...@@ -543,7 +543,44 @@ package body Prj.PP is
end if; end if;
Write_String (" use "); Write_String (" use ");
Print (Expression_Of (Node, In_Tree), Indent);
if Present (Expression_Of (Node, In_Tree)) then
Print (Expression_Of (Node, In_Tree), Indent);
else
-- Full associative array declaration
if
Present (Associative_Project_Of (Node, In_Tree))
then
Output_Name
(Name_Of
(Associative_Project_Of (Node, In_Tree),
In_Tree));
if
Present (Associative_Package_Of (Node, In_Tree))
then
Write_String (".");
Output_Name
(Name_Of
(Associative_Package_Of (Node, In_Tree),
In_Tree));
end if;
elsif
Present (Associative_Package_Of (Node, In_Tree))
then
Output_Name
(Name_Of
(Associative_Package_Of (Node, In_Tree),
In_Tree));
end if;
Write_String ("'");
Output_Attribute_Name (Name_Of (Node, In_Tree));
end if;
Write_String (";"); Write_String (";");
Write_End_Of_Line_Comment (Node); Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent); Print (First_Comment_After (Node, In_Tree), Indent);
...@@ -580,11 +617,11 @@ package body Prj.PP is ...@@ -580,11 +617,11 @@ package body Prj.PP is
Term : Project_Node_Id := First_Term (Node, In_Tree); Term : Project_Node_Id := First_Term (Node, In_Tree);
begin begin
while Term /= Empty_Node loop while Present (Term) loop
Print (Term, Indent); Print (Term, Indent);
Term := Next_Term (Term, In_Tree); Term := Next_Term (Term, In_Tree);
if Term /= Empty_Node then if Present (Term) then
Write_String (" & "); Write_String (" & ");
end if; end if;
end loop; end loop;
...@@ -603,12 +640,12 @@ package body Prj.PP is ...@@ -603,12 +640,12 @@ package body Prj.PP is
First_Expression_In_List (Node, In_Tree); First_Expression_In_List (Node, In_Tree);
begin begin
while Expression /= Empty_Node loop while Present (Expression) loop
Print (Expression, Indent); Print (Expression, Indent);
Expression := Expression :=
Next_Expression_In_List (Expression, In_Tree); Next_Expression_In_List (Expression, In_Tree);
if Expression /= Empty_Node then if Present (Expression) then
Write_String (", "); Write_String (", ");
end if; end if;
end loop; end loop;
...@@ -618,13 +655,13 @@ package body Prj.PP is ...@@ -618,13 +655,13 @@ package body Prj.PP is
when N_Variable_Reference => when N_Variable_Reference =>
pragma Debug (Indicate_Tested (N_Variable_Reference)); pragma Debug (Indicate_Tested (N_Variable_Reference));
if Project_Node_Of (Node, In_Tree) /= Empty_Node then if Present (Project_Node_Of (Node, In_Tree)) then
Output_Name Output_Name
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree)); (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
Write_String ("."); Write_String (".");
end if; end if;
if Package_Node_Of (Node, In_Tree) /= Empty_Node then if Present (Package_Node_Of (Node, In_Tree)) then
Output_Name Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree)); (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
Write_String ("."); Write_String (".");
...@@ -637,7 +674,7 @@ package body Prj.PP is ...@@ -637,7 +674,7 @@ package body Prj.PP is
Write_String ("external ("); Write_String ("external (");
Print (External_Reference_Of (Node, In_Tree), Indent); Print (External_Reference_Of (Node, In_Tree), Indent);
if External_Default_Of (Node, In_Tree) /= Empty_Node then if Present (External_Default_Of (Node, In_Tree)) then
Write_String (", "); Write_String (", ");
Print (External_Default_Of (Node, In_Tree), Indent); Print (External_Default_Of (Node, In_Tree), Indent);
end if; end if;
...@@ -647,19 +684,19 @@ package body Prj.PP is ...@@ -647,19 +684,19 @@ package body Prj.PP is
when N_Attribute_Reference => when N_Attribute_Reference =>
pragma Debug (Indicate_Tested (N_Attribute_Reference)); pragma Debug (Indicate_Tested (N_Attribute_Reference));
if Project_Node_Of (Node, In_Tree) /= Empty_Node if Present (Project_Node_Of (Node, In_Tree))
and then Project_Node_Of (Node, In_Tree) /= Project and then Project_Node_Of (Node, In_Tree) /= Project
then then
Output_Name Output_Name
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree)); (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
if Package_Node_Of (Node, In_Tree) /= Empty_Node then if Present (Package_Node_Of (Node, In_Tree)) then
Write_String ("."); Write_String (".");
Output_Name Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree)); (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
end if; end if;
elsif Package_Node_Of (Node, In_Tree) /= Empty_Node then elsif Present (Package_Node_Of (Node, In_Tree)) then
Output_Name Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree)); (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
...@@ -691,10 +728,10 @@ package body Prj.PP is ...@@ -691,10 +728,10 @@ package body Prj.PP is
begin begin
Case_Item := First_Case_Item_Of (Node, In_Tree); Case_Item := First_Case_Item_Of (Node, In_Tree);
while Case_Item /= Empty_Node loop while Present (Case_Item) loop
if First_Declarative_Item_Of (Case_Item, In_Tree) /= if Present
Empty_Node (First_Declarative_Item_Of (Case_Item, In_Tree))
or else not Eliminate_Empty_Case_Constructions or else not Eliminate_Empty_Case_Constructions
then then
Is_Non_Empty := True; Is_Non_Empty := True;
exit; exit;
...@@ -721,7 +758,7 @@ package body Prj.PP is ...@@ -721,7 +758,7 @@ package body Prj.PP is
Case_Item : Project_Node_Id := Case_Item : Project_Node_Id :=
First_Case_Item_Of (Node, In_Tree); First_Case_Item_Of (Node, In_Tree);
begin begin
while Case_Item /= Empty_Node loop while Present (Case_Item) loop
pragma Assert pragma Assert
(Kind_Of (Case_Item, In_Tree) = N_Case_Item); (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
Print (Case_Item, Indent + Increment); Print (Case_Item, Indent + Increment);
...@@ -742,7 +779,7 @@ package body Prj.PP is ...@@ -742,7 +779,7 @@ package body Prj.PP is
when N_Case_Item => when N_Case_Item =>
pragma Debug (Indicate_Tested (N_Case_Item)); pragma Debug (Indicate_Tested (N_Case_Item));
if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node if Present (First_Declarative_Item_Of (Node, In_Tree))
or else not Eliminate_Empty_Case_Constructions or else not Eliminate_Empty_Case_Constructions
then then
Write_Empty_Line; Write_Empty_Line;
...@@ -750,7 +787,7 @@ package body Prj.PP is ...@@ -750,7 +787,7 @@ package body Prj.PP is
Start_Line (Indent); Start_Line (Indent);
Write_String ("when "); Write_String ("when ");
if First_Choice_Of (Node, In_Tree) = Empty_Node then if No (First_Choice_Of (Node, In_Tree)) then
Write_String ("others"); Write_String ("others");
else else
...@@ -758,11 +795,11 @@ package body Prj.PP is ...@@ -758,11 +795,11 @@ package body Prj.PP is
Label : Project_Node_Id := Label : Project_Node_Id :=
First_Choice_Of (Node, In_Tree); First_Choice_Of (Node, In_Tree);
begin begin
while Label /= Empty_Node loop while Present (Label) loop
Print (Label, Indent); Print (Label, Indent);
Label := Next_Literal_String (Label, In_Tree); Label := Next_Literal_String (Label, In_Tree);
if Label /= Empty_Node then if Present (Label) then
Write_String (" | "); Write_String (" | ");
end if; end if;
end loop; end loop;
...@@ -779,7 +816,7 @@ package body Prj.PP is ...@@ -779,7 +816,7 @@ package body Prj.PP is
First : constant Project_Node_Id := First : constant Project_Node_Id :=
First_Declarative_Item_Of (Node, In_Tree); First_Declarative_Item_Of (Node, In_Tree);
begin begin
if First = Empty_Node then if No (First) then
Write_Empty_Line; Write_Empty_Line;
else else
Print (First, Indent + Increment); Print (First, Indent + Increment);
......
gcc/ada/prj-proc.adb
...@@ -463,7 +463,7 @@ package body Prj.Proc is ...@@ -463,7 +463,7 @@ package body Prj.Proc is
-- Process each term of the expression, starting with First_Term -- Process each term of the expression, starting with First_Term
while The_Term /= Empty_Node loop while Present (The_Term) loop
The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree); The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
case Kind_Of (The_Current_Term, From_Project_Node_Tree) is case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
...@@ -535,7 +535,7 @@ package body Prj.Proc is ...@@ -535,7 +535,7 @@ package body Prj.Proc is
Value : Variable_Value; Value : Variable_Value;
begin begin
if String_Node /= Empty_Node then if Present (String_Node) then
-- If String_Node is nil, it is an empty list, -- If String_Node is nil, it is an empty list,
-- there is nothing to do -- there is nothing to do
...@@ -586,7 +586,7 @@ package body Prj.Proc is ...@@ -586,7 +586,7 @@ package body Prj.Proc is
Next_Expression_In_List Next_Expression_In_List
(String_Node, From_Project_Node_Tree); (String_Node, From_Project_Node_Tree);
exit when String_Node = Empty_Node; exit when No (String_Node);
Value := Value :=
Expression Expression
...@@ -637,7 +637,7 @@ package body Prj.Proc is ...@@ -637,7 +637,7 @@ package body Prj.Proc is
Index : Name_Id := No_Name; Index : Name_Id := No_Name;
begin begin
if Term_Project /= Empty_Node and then if Present (Term_Project) and then
Term_Project /= From_Project_Node Term_Project /= From_Project_Node
then then
-- This variable or attribute comes from another project -- This variable or attribute comes from another project
...@@ -650,7 +650,7 @@ package body Prj.Proc is ...@@ -650,7 +650,7 @@ package body Prj.Proc is
With_Name => The_Name); With_Name => The_Name);
end if; end if;
if Term_Package /= Empty_Node then if Present (Term_Package) then
-- This is an attribute of a package -- This is an attribute of a package
...@@ -1003,11 +1003,11 @@ package body Prj.Proc is ...@@ -1003,11 +1003,11 @@ package body Prj.Proc is
-- If there is a default value for the external reference, -- If there is a default value for the external reference,
-- get its value. -- get its value.
if Default_Node /= Empty_Node then if Present (Default_Node) then
Def_Var := Expression Def_Var := Expression
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
From_Project_Node => Default_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg, Pkg => Pkg,
First_Term => First_Term =>
...@@ -1252,7 +1252,7 @@ package body Prj.Proc is ...@@ -1252,7 +1252,7 @@ package body Prj.Proc is
Current_Item := Empty_Node; Current_Item := Empty_Node;
Current_Declarative_Item := Item; Current_Declarative_Item := Item;
while Current_Declarative_Item /= Empty_Node loop while Present (Current_Declarative_Item) loop
-- Get its data -- Get its data
...@@ -1314,7 +1314,7 @@ package body Prj.Proc is ...@@ -1314,7 +1314,7 @@ package body Prj.Proc is
In_Tree.Packages.Table (New_Pkg) := In_Tree.Packages.Table (New_Pkg) :=
The_New_Package; The_New_Package;
if Project_Of_Renamed_Package /= Empty_Node then if Present (Project_Of_Renamed_Package) then
-- Renamed package -- Renamed package
...@@ -1472,9 +1472,9 @@ package body Prj.Proc is ...@@ -1472,9 +1472,9 @@ package body Prj.Proc is
if Pkg /= No_Package then if Pkg /= No_Package then
In_Tree.Arrays.Table (New_Array) := In_Tree.Arrays.Table (New_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Value => No_Array_Element, Value => No_Array_Element,
Next => Next =>
In_Tree.Packages.Table (Pkg).Decl.Arrays); In_Tree.Packages.Table (Pkg).Decl.Arrays);
In_Tree.Packages.Table (Pkg).Decl.Arrays := In_Tree.Packages.Table (Pkg).Decl.Arrays :=
...@@ -1482,9 +1482,9 @@ package body Prj.Proc is ...@@ -1482,9 +1482,9 @@ package body Prj.Proc is
else else
In_Tree.Arrays.Table (New_Array) := In_Tree.Arrays.Table (New_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Value => No_Array_Element, Value => No_Array_Element,
Next => Next =>
In_Tree.Projects.Table (Project).Decl.Arrays); In_Tree.Projects.Table (Project).Decl.Arrays);
In_Tree.Projects.Table (Project).Decl.Arrays := In_Tree.Projects.Table (Project).Decl.Arrays :=
...@@ -1515,8 +1515,8 @@ package body Prj.Proc is ...@@ -1515,8 +1515,8 @@ package body Prj.Proc is
pragma Assert (Orig_Project /= No_Project, pragma Assert (Orig_Project /= No_Project,
"original project not found"); "original project not found");
if Associative_Package_Of if No (Associative_Package_Of
(Current_Item, From_Project_Node_Tree) = Empty_Node (Current_Item, From_Project_Node_Tree))
then then
Orig_Array := Orig_Array :=
In_Tree.Projects.Table In_Tree.Projects.Table
...@@ -1732,7 +1732,7 @@ package body Prj.Proc is ...@@ -1732,7 +1732,7 @@ package body Prj.Proc is
(String_Type_Of (Current_Item, (String_Type_Of (Current_Item,
From_Project_Node_Tree), From_Project_Node_Tree),
From_Project_Node_Tree); From_Project_Node_Tree);
while Current_String /= Empty_Node while Present (Current_String)
and then and then
String_Value_Of String_Value_Of
(Current_String, From_Project_Node_Tree) /= (Current_String, From_Project_Node_Tree) /=
...@@ -1746,7 +1746,7 @@ package body Prj.Proc is ...@@ -1746,7 +1746,7 @@ package body Prj.Proc is
-- Report an error if the string value is not -- Report an error if the string value is not
-- one for the string type. -- one for the string type.
if Current_String = Empty_Node then if No (Current_String) then
Error_Msg_Name_1 := New_Value.Value; Error_Msg_Name_1 := New_Value.Value;
Error_Msg_Name_2 := Error_Msg_Name_2 :=
Name_Of Name_Of
...@@ -1849,21 +1849,21 @@ package body Prj.Proc is ...@@ -1849,21 +1849,21 @@ package body Prj.Proc is
if Pkg /= No_Package then if Pkg /= No_Package then
In_Tree.Variable_Elements.Table (The_Variable) := In_Tree.Variable_Elements.Table (The_Variable) :=
(Next => (Next =>
In_Tree.Packages.Table In_Tree.Packages.Table
(Pkg).Decl.Variables, (Pkg).Decl.Variables,
Name => Current_Item_Name, Name => Current_Item_Name,
Value => New_Value); Value => New_Value);
In_Tree.Packages.Table In_Tree.Packages.Table
(Pkg).Decl.Variables := The_Variable; (Pkg).Decl.Variables := The_Variable;
else else
In_Tree.Variable_Elements.Table (The_Variable) := In_Tree.Variable_Elements.Table (The_Variable) :=
(Next => (Next =>
In_Tree.Projects.Table In_Tree.Projects.Table
(Project).Decl.Variables, (Project).Decl.Variables,
Name => Current_Item_Name, Name => Current_Item_Name,
Value => New_Value); Value => New_Value);
In_Tree.Projects.Table In_Tree.Projects.Table
(Project).Decl.Variables := (Project).Decl.Variables :=
The_Variable; The_Variable;
...@@ -1957,9 +1957,9 @@ package body Prj.Proc is ...@@ -1957,9 +1957,9 @@ package body Prj.Proc is
if Pkg /= No_Package then if Pkg /= No_Package then
In_Tree.Arrays.Table (The_Array) := In_Tree.Arrays.Table (The_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Value => No_Array_Element, Value => No_Array_Element,
Next => Next =>
In_Tree.Packages.Table In_Tree.Packages.Table
(Pkg).Decl.Arrays); (Pkg).Decl.Arrays);
...@@ -1968,9 +1968,9 @@ package body Prj.Proc is ...@@ -1968,9 +1968,9 @@ package body Prj.Proc is
else else
In_Tree.Arrays.Table (The_Array) := In_Tree.Arrays.Table (The_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Value => No_Array_Element, Value => No_Array_Element,
Next => Next =>
In_Tree.Projects.Table In_Tree.Projects.Table
(Project).Decl.Arrays); (Project).Decl.Arrays);
...@@ -2019,7 +2019,7 @@ package body Prj.Proc is ...@@ -2019,7 +2019,7 @@ package body Prj.Proc is
not Case_Insensitive not Case_Insensitive
(Current_Item, From_Project_Node_Tree), (Current_Item, From_Project_Node_Tree),
Value => New_Value, Value => New_Value,
Next => In_Tree.Arrays.Table Next => In_Tree.Arrays.Table
(The_Array).Value); (The_Array).Value);
In_Tree.Arrays.Table In_Tree.Arrays.Table
(The_Array).Value := The_Array_Element; (The_Array).Value := The_Array_Element;
...@@ -2068,8 +2068,8 @@ package body Prj.Proc is ...@@ -2068,8 +2068,8 @@ package body Prj.Proc is
-- If a project was specified for the case variable, -- If a project was specified for the case variable,
-- get its id. -- get its id.
if Project_Node_Of if Present (Project_Node_Of
(Variable_Node, From_Project_Node_Tree) /= Empty_Node (Variable_Node, From_Project_Node_Tree))
then then
Name := Name :=
Name_Of Name_Of
...@@ -2084,8 +2084,8 @@ package body Prj.Proc is ...@@ -2084,8 +2084,8 @@ package body Prj.Proc is
-- If a package were specified for the case variable, -- If a package were specified for the case variable,
-- get its id. -- get its id.
if Package_Node_Of if Present (Package_Node_Of
(Variable_Node, From_Project_Node_Tree) /= Empty_Node (Variable_Node, From_Project_Node_Tree))
then then
Name := Name :=
Name_Of Name_Of
...@@ -2121,8 +2121,8 @@ package body Prj.Proc is ...@@ -2121,8 +2121,8 @@ package body Prj.Proc is
if Var_Id = No_Variable if Var_Id = No_Variable
and then and then
Package_Node_Of No (Package_Node_Of
(Variable_Node, From_Project_Node_Tree) = Empty_Node (Variable_Node, From_Project_Node_Tree))
then then
Var_Id := In_Tree.Projects.Table Var_Id := In_Tree.Projects.Table
(The_Project).Decl.Variables; (The_Project).Decl.Variables;
...@@ -2172,14 +2172,14 @@ package body Prj.Proc is ...@@ -2172,14 +2172,14 @@ package body Prj.Proc is
Case_Item := Case_Item :=
First_Case_Item_Of (Current_Item, From_Project_Node_Tree); First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
Case_Item_Loop : Case_Item_Loop :
while Case_Item /= Empty_Node loop while Present (Case_Item) loop
Choice_String := Choice_String :=
First_Choice_Of (Case_Item, From_Project_Node_Tree); First_Choice_Of (Case_Item, From_Project_Node_Tree);
-- When Choice_String is nil, it means that it is -- When Choice_String is nil, it means that it is
-- the "when others =>" alternative. -- the "when others =>" alternative.
if Choice_String = Empty_Node then if No (Choice_String) then
Decl_Item := Decl_Item :=
First_Declarative_Item_Of First_Declarative_Item_Of
(Case_Item, From_Project_Node_Tree); (Case_Item, From_Project_Node_Tree);
...@@ -2189,7 +2189,7 @@ package body Prj.Proc is ...@@ -2189,7 +2189,7 @@ package body Prj.Proc is
-- Look into all the alternative of this case item -- Look into all the alternative of this case item
Choice_Loop : Choice_Loop :
while Choice_String /= Empty_Node loop while Present (Choice_String) loop
if Case_Value = if Case_Value =
String_Value_Of String_Value_Of
(Choice_String, From_Project_Node_Tree) (Choice_String, From_Project_Node_Tree)
...@@ -2211,7 +2211,7 @@ package body Prj.Proc is ...@@ -2211,7 +2211,7 @@ package body Prj.Proc is
-- If there is an alternative, then we process it -- If there is an alternative, then we process it
if Decl_Item /= Empty_Node then if Present (Decl_Item) then
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
...@@ -2486,7 +2486,7 @@ package body Prj.Proc is ...@@ -2486,7 +2486,7 @@ package body Prj.Proc is
With_Clause : Project_Node_Id; With_Clause : Project_Node_Id;
begin begin
if From_Project_Node = Empty_Node then if No (From_Project_Node) then
Project := No_Project; Project := No_Project;
else else
...@@ -2591,7 +2591,7 @@ package body Prj.Proc is ...@@ -2591,7 +2591,7 @@ package body Prj.Proc is
With_Clause := With_Clause :=
First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree); First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
while With_Clause /= Empty_Node loop while Present (With_Clause) loop
declare declare
New_Project : Project_Id; New_Project : Project_Id;
New_Data : Project_Data; New_Data : Project_Data;
...@@ -2602,7 +2602,7 @@ package body Prj.Proc is ...@@ -2602,7 +2602,7 @@ package body Prj.Proc is
Non_Limited_Project_Node_Of Non_Limited_Project_Node_Of
(With_Clause, From_Project_Node_Tree); (With_Clause, From_Project_Node_Tree);
if Proj_Node /= Empty_Node then if Present (Proj_Node) then
Recursive_Process Recursive_Process
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => New_Project, Project => New_Project,
...@@ -2799,7 +2799,7 @@ package body Prj.Proc is ...@@ -2799,7 +2799,7 @@ package body Prj.Proc is
With_Clause := With_Clause :=
First_With_Clause_Of First_With_Clause_Of
(From_Project_Node, From_Project_Node_Tree); (From_Project_Node, From_Project_Node_Tree);
while With_Clause /= Empty_Node loop while Present (With_Clause) loop
declare declare
New_Project : Project_Id; New_Project : Project_Id;
New_Data : Project_Data; New_Data : Project_Data;
...@@ -2810,7 +2810,7 @@ package body Prj.Proc is ...@@ -2810,7 +2810,7 @@ package body Prj.Proc is
Non_Limited_Project_Node_Of Non_Limited_Project_Node_Of
(With_Clause, From_Project_Node_Tree); (With_Clause, From_Project_Node_Tree);
if Proj_Node = Empty_Node then if No (Proj_Node) then
Recursive_Process Recursive_Process
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => New_Project, Project => New_Project,
......
gcc/ada/prj-strt.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -244,7 +244,7 @@ package body Prj.Strt is ...@@ -244,7 +244,7 @@ package body Prj.Strt is
-- Change name of obsolete attributes -- Change name of obsolete attributes
if Reference /= Empty_Node then if Present (Reference) then
case Name_Of (Reference, In_Tree) is case Name_Of (Reference, In_Tree) is
when Snames.Name_Specification => when Snames.Name_Specification =>
Set_Name_Of (Reference, In_Tree, To => Snames.Name_Spec); Set_Name_Of (Reference, In_Tree, To => Snames.Name_Spec);
...@@ -716,7 +716,7 @@ package body Prj.Strt is ...@@ -716,7 +716,7 @@ package body Prj.Strt is
(Current_Project, In_Tree, Names.Table (1).Name); (Current_Project, In_Tree, Names.Table (1).Name);
end if; end if;
if The_Project = Empty_Node then if No (The_Project) then
-- If it is neither a project name nor a package name, -- If it is neither a project name nor a package name,
-- report an error. -- report an error.
...@@ -734,7 +734,7 @@ package body Prj.Strt is ...@@ -734,7 +734,7 @@ package body Prj.Strt is
The_Package := The_Package :=
First_Package_Of (Current_Project, In_Tree); First_Package_Of (Current_Project, In_Tree);
while The_Package /= Empty_Node while Present (The_Package)
and then Name_Of (The_Package, In_Tree) /= and then Name_Of (The_Package, In_Tree) /=
Names.Table (1).Name Names.Table (1).Name
loop loop
...@@ -745,7 +745,7 @@ package body Prj.Strt is ...@@ -745,7 +745,7 @@ package body Prj.Strt is
-- If it has not been already declared, report an -- If it has not been already declared, report an
-- error. -- error.
if The_Package = Empty_Node then if No (The_Package) then
Error_Msg_Name_1 := Names.Table (1).Name; Error_Msg_Name_1 := Names.Table (1).Name;
Error_Msg ("package % not yet defined", Error_Msg ("package % not yet defined",
Names.Table (1).Location); Names.Table (1).Location);
...@@ -820,7 +820,7 @@ package body Prj.Strt is ...@@ -820,7 +820,7 @@ package body Prj.Strt is
-- If the long project exists, then this is the prefix -- If the long project exists, then this is the prefix
-- of the attribute. -- of the attribute.
if The_Project /= Empty_Node then if Present (The_Project) then
First_Attribute := Attribute_First; First_Attribute := Attribute_First;
The_Package := Empty_Node; The_Package := Empty_Node;
...@@ -841,7 +841,7 @@ package body Prj.Strt is ...@@ -841,7 +841,7 @@ package body Prj.Strt is
-- If short project does not exist, report an error -- If short project does not exist, report an error
if The_Project = Empty_Node then if No (The_Project) then
Error_Msg_Name_1 := Long_Project; Error_Msg_Name_1 := Long_Project;
Error_Msg_Name_2 := Short_Project; Error_Msg_Name_2 := Short_Project;
Error_Msg ("unknown projects % or %", Error_Msg ("unknown projects % or %",
...@@ -855,7 +855,7 @@ package body Prj.Strt is ...@@ -855,7 +855,7 @@ package body Prj.Strt is
The_Package := The_Package :=
First_Package_Of (The_Project, In_Tree); First_Package_Of (The_Project, In_Tree);
while The_Package /= Empty_Node while Present (The_Package)
and then Name_Of (The_Package, In_Tree) /= and then Name_Of (The_Package, In_Tree) /=
Names.Table (Names.Last).Name Names.Table (Names.Last).Name
loop loop
...@@ -865,7 +865,7 @@ package body Prj.Strt is ...@@ -865,7 +865,7 @@ package body Prj.Strt is
-- If it has not, then we report an error -- If it has not, then we report an error
if The_Package = Empty_Node then if No (The_Package) then
Error_Msg_Name_1 := Error_Msg_Name_1 :=
Names.Table (Names.Last).Name; Names.Table (Names.Last).Name;
Error_Msg_Name_2 := Short_Project; Error_Msg_Name_2 := Short_Project;
...@@ -926,7 +926,7 @@ package body Prj.Strt is ...@@ -926,7 +926,7 @@ package body Prj.Strt is
The_Package := First_Package_Of (Current_Project, In_Tree); The_Package := First_Package_Of (Current_Project, In_Tree);
while The_Package /= Empty_Node while Present (The_Package)
and then Name_Of (The_Package, In_Tree) /= and then Name_Of (The_Package, In_Tree) /=
Names.Table (1).Name Names.Table (1).Name
loop loop
...@@ -939,10 +939,10 @@ package body Prj.Strt is ...@@ -939,10 +939,10 @@ package body Prj.Strt is
The_Project := Imported_Or_Extended_Project_Of The_Project := Imported_Or_Extended_Project_Of
(Current_Project, In_Tree, Names.Table (1).Name); (Current_Project, In_Tree, Names.Table (1).Name);
if The_Project /= Empty_Node then if Present (The_Project) then
Specified_Project := The_Project; Specified_Project := The_Project;
elsif The_Package = Empty_Node then elsif No (The_Package) then
Error_Msg_Name_1 := Names.Table (1).Name; Error_Msg_Name_1 := Names.Table (1).Name;
Error_Msg ("unknown package or project %", Error_Msg ("unknown package or project %",
Names.Table (1).Location); Names.Table (1).Location);
...@@ -1004,7 +1004,7 @@ package body Prj.Strt is ...@@ -1004,7 +1004,7 @@ package body Prj.Strt is
The_Project := Imported_Or_Extended_Project_Of The_Project := Imported_Or_Extended_Project_Of
(Current_Project, In_Tree, Long_Project); (Current_Project, In_Tree, Long_Project);
if The_Project /= Empty_Node then if Present (The_Project) then
Specified_Project := The_Project; Specified_Project := The_Project;
else else
...@@ -1017,7 +1017,7 @@ package body Prj.Strt is ...@@ -1017,7 +1017,7 @@ package body Prj.Strt is
Imported_Or_Extended_Project_Of Imported_Or_Extended_Project_Of
(Current_Project, In_Tree, Short_Project); (Current_Project, In_Tree, Short_Project);
if The_Project = Empty_Node then if No (The_Project) then
-- Unknown prefix, report an error -- Unknown prefix, report an error
Error_Msg_Name_1 := Long_Project; Error_Msg_Name_1 := Long_Project;
...@@ -1034,7 +1034,7 @@ package body Prj.Strt is ...@@ -1034,7 +1034,7 @@ package body Prj.Strt is
The_Package := First_Package_Of (The_Project, In_Tree); The_Package := First_Package_Of (The_Project, In_Tree);
while The_Package /= Empty_Node while Present (The_Package)
and then Name_Of (The_Package, In_Tree) /= and then Name_Of (The_Package, In_Tree) /=
Names.Table (Names.Last - 1).Name Names.Table (Names.Last - 1).Name
loop loop
...@@ -1042,7 +1042,7 @@ package body Prj.Strt is ...@@ -1042,7 +1042,7 @@ package body Prj.Strt is
Next_Package_In_Project (The_Package, In_Tree); Next_Package_In_Project (The_Package, In_Tree);
end loop; end loop;
if The_Package = Empty_Node then if No (The_Package) then
-- The package does not exist, report an error -- The package does not exist, report an error
...@@ -1065,7 +1065,7 @@ package body Prj.Strt is ...@@ -1065,7 +1065,7 @@ package body Prj.Strt is
Set_Project_Node_Of (Variable, In_Tree, To => Specified_Project); Set_Project_Node_Of (Variable, In_Tree, To => Specified_Project);
Set_Package_Node_Of (Variable, In_Tree, To => Specified_Package); Set_Package_Node_Of (Variable, In_Tree, To => Specified_Package);
if Specified_Project /= Empty_Node then if Present (Specified_Project) then
The_Project := Specified_Project; The_Project := Specified_Project;
else else
The_Project := Current_Project; The_Project := Current_Project;
...@@ -1078,10 +1078,10 @@ package body Prj.Strt is ...@@ -1078,10 +1078,10 @@ package body Prj.Strt is
-- If a package was specified, check if the variable has been -- If a package was specified, check if the variable has been
-- declared in this package. -- declared in this package.
if Specified_Package /= Empty_Node then if Present (Specified_Package) then
Current_Variable := Current_Variable :=
First_Variable_Of (Specified_Package, In_Tree); First_Variable_Of (Specified_Package, In_Tree);
while Current_Variable /= Empty_Node while Present (Current_Variable)
and then and then
Name_Of (Current_Variable, In_Tree) /= Variable_Name Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop loop
...@@ -1093,12 +1093,12 @@ package body Prj.Strt is ...@@ -1093,12 +1093,12 @@ package body Prj.Strt is
-- a package, first check if the variable has been declared in -- a package, first check if the variable has been declared in
-- the package. -- the package.
if Specified_Project = Empty_Node if No (Specified_Project)
and then Current_Package /= Empty_Node and then Present (Current_Package)
then then
Current_Variable := Current_Variable :=
First_Variable_Of (Current_Package, In_Tree); First_Variable_Of (Current_Package, In_Tree);
while Current_Variable /= Empty_Node while Present (Current_Variable)
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop loop
Current_Variable := Current_Variable :=
...@@ -1107,29 +1107,47 @@ package body Prj.Strt is ...@@ -1107,29 +1107,47 @@ package body Prj.Strt is
end if; end if;
-- If we have not found the variable in the package, check if the -- If we have not found the variable in the package, check if the
-- variable has been declared in the project. -- variable has been declared in the project, or in any of its
-- ancestors.
if Current_Variable = Empty_Node then if No (Current_Variable) then
Current_Variable := First_Variable_Of (The_Project, In_Tree); declare
while Current_Variable /= Empty_Node Proj : Project_Node_Id := The_Project;
and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop begin
Current_Variable := loop
Next_Variable (Current_Variable, In_Tree); Current_Variable := First_Variable_Of (Proj, In_Tree);
end loop; while
Present (Current_Variable)
and then
Name_Of (Current_Variable, In_Tree) /= Variable_Name
loop
Current_Variable :=
Next_Variable (Current_Variable, In_Tree);
end loop;
exit when Present (Current_Variable);
Proj := Parent_Project_Of (Proj, In_Tree);
Set_Project_Node_Of (Variable, In_Tree, To => Proj);
exit when No (Proj);
end loop;
end;
end if; end if;
end if; end if;
-- If the variable was not found, report an error -- If the variable was not found, report an error
if Current_Variable = Empty_Node then if No (Current_Variable) then
Error_Msg_Name_1 := Variable_Name; Error_Msg_Name_1 := Variable_Name;
Error_Msg Error_Msg
("unknown variable %", Names.Table (Names.Last).Location); ("unknown variable %", Names.Table (Names.Last).Location);
end if; end if;
end if; end if;
if Current_Variable /= Empty_Node then if Present (Current_Variable) then
Set_Expression_Kind_Of Set_Expression_Kind_Of
(Variable, In_Tree, (Variable, In_Tree,
To => Expression_Kind_Of (Current_Variable, In_Tree)); To => Expression_Kind_Of (Current_Variable, In_Tree));
...@@ -1185,9 +1203,9 @@ package body Prj.Strt is ...@@ -1185,9 +1203,9 @@ package body Prj.Strt is
-- Add the literal of the string type to the Choices table -- Add the literal of the string type to the Choices table
if String_Type /= Empty_Node then if Present (String_Type) then
Current_String := First_Literal_String (String_Type, In_Tree); Current_String := First_Literal_String (String_Type, In_Tree);
while Current_String /= Empty_Node loop while Present (Current_String) loop
Add (This_String => String_Value_Of (Current_String, In_Tree)); Add (This_String => String_Value_Of (Current_String, In_Tree));
Current_String := Next_Literal_String (Current_String, In_Tree); Current_String := Next_Literal_String (Current_String, In_Tree);
end loop; end loop;
...@@ -1290,7 +1308,7 @@ package body Prj.Strt is ...@@ -1290,7 +1308,7 @@ package body Prj.Strt is
-- If Current_Expression is empty, it means that the -- If Current_Expression is empty, it means that the
-- expression is the first in the string list. -- expression is the first in the string list.
if Current_Expression = Empty_Node then if No (Current_Expression) then
Set_First_Expression_In_List Set_First_Expression_In_List
(Term_Id, In_Tree, To => Next_Expression); (Term_Id, In_Tree, To => Next_Expression);
else else
...@@ -1382,7 +1400,7 @@ package body Prj.Strt is ...@@ -1382,7 +1400,7 @@ package body Prj.Strt is
Current_Package => Current_Package); Current_Package => Current_Package);
Set_Current_Term (Term, In_Tree, To => Reference); Set_Current_Term (Term, In_Tree, To => Reference);
if Reference /= Empty_Node then if Present (Reference) then
-- If we don't know the expression kind (first term), then it -- If we don't know the expression kind (first term), then it
-- has the kind of the variable or attribute reference. -- has the kind of the variable or attribute reference.
...@@ -1425,7 +1443,7 @@ package body Prj.Strt is ...@@ -1425,7 +1443,7 @@ package body Prj.Strt is
-- Same checks as above for the expression kind -- Same checks as above for the expression kind
if Reference /= Empty_Node then if Present (Reference) then
if Expr_Kind = Undefined then if Expr_Kind = Undefined then
Expr_Kind := Expression_Kind_Of (Reference, In_Tree); Expr_Kind := Expression_Kind_Of (Reference, In_Tree);
......
gcc/ada/prj-tree.adb
...@@ -94,13 +94,13 @@ package body Prj.Tree is ...@@ -94,13 +94,13 @@ package body Prj.Tree is
begin begin
pragma Assert pragma Assert
(To /= Empty_Node (Present (To)
and then and then
In_Tree.Project_Nodes.Table (To).Kind /= N_Comment); In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
Zone := In_Tree.Project_Nodes.Table (To).Comments; Zone := In_Tree.Project_Nodes.Table (To).Comments;
if Zone = Empty_Node then if No (Zone) then
-- Create new N_Comment_Zones node -- Create new N_Comment_Zones node
...@@ -122,6 +122,7 @@ package body Prj.Tree is ...@@ -122,6 +122,7 @@ package body Prj.Tree is
Field1 => Empty_Node, Field1 => Empty_Node,
Field2 => Empty_Node, Field2 => Empty_Node,
Field3 => Empty_Node, Field3 => Empty_Node,
Field4 => Empty_Node,
Flag1 => False, Flag1 => False,
Flag2 => False, Flag2 => False,
Comments => Empty_Node); Comments => Empty_Node);
...@@ -171,12 +172,13 @@ package body Prj.Tree is ...@@ -171,12 +172,13 @@ package body Prj.Tree is
Field1 => Empty_Node, Field1 => Empty_Node,
Field2 => Empty_Node, Field2 => Empty_Node,
Field3 => Empty_Node, Field3 => Empty_Node,
Field4 => Empty_Node,
Comments => Empty_Node); Comments => Empty_Node);
-- If this is the first comment, put it in the right field of -- If this is the first comment, put it in the right field of
-- the node Zone. -- the node Zone.
if Previous = Empty_Node then if No (Previous) then
case Where is case Where is
when Before => when Before =>
In_Tree.Project_Nodes.Table (Zone).Field1 := In_Tree.Project_Nodes.Table (Zone).Field1 :=
...@@ -228,7 +230,7 @@ package body Prj.Tree is ...@@ -228,7 +230,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else or else
...@@ -246,7 +248,7 @@ package body Prj.Tree is ...@@ -246,7 +248,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return In_Tree.Project_Nodes.Table (Node).Field3; return In_Tree.Project_Nodes.Table (Node).Field3;
...@@ -262,7 +264,7 @@ package body Prj.Tree is ...@@ -262,7 +264,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -277,7 +279,7 @@ package body Prj.Tree is ...@@ -277,7 +279,7 @@ package body Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Boolean is In_Tree : Project_Node_Tree_Ref) return Boolean is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else or else
...@@ -295,7 +297,7 @@ package body Prj.Tree is ...@@ -295,7 +297,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -312,13 +314,13 @@ package body Prj.Tree is ...@@ -312,13 +314,13 @@ package body Prj.Tree is
Zone : Project_Node_Id; Zone : Project_Node_Id;
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments; Zone := In_Tree.Project_Nodes.Table (Node).Comments;
-- If there is not already an N_Comment_Zones associated, create a new -- If there is not already an N_Comment_Zones associated, create a new
-- one and associate it with node Node. -- 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); Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table (Zone) := In_Tree.Project_Nodes.Table (Zone) :=
...@@ -337,6 +339,7 @@ package body Prj.Tree is ...@@ -337,6 +339,7 @@ package body Prj.Tree is
Field1 => Empty_Node, Field1 => Empty_Node,
Field2 => Empty_Node, Field2 => Empty_Node,
Field3 => Empty_Node, Field3 => Empty_Node,
Field4 => Empty_Node,
Flag1 => False, Flag1 => False,
Flag2 => False, Flag2 => False,
Comments => Empty_Node); Comments => Empty_Node);
...@@ -356,7 +359,7 @@ package body Prj.Tree is ...@@ -356,7 +359,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -372,7 +375,7 @@ package body Prj.Tree is ...@@ -372,7 +375,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term); In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -412,6 +415,7 @@ package body Prj.Tree is ...@@ -412,6 +415,7 @@ package body Prj.Tree is
Field1 => Empty_Node, Field1 => Empty_Node,
Field2 => Empty_Node, Field2 => Empty_Node,
Field3 => Empty_Node, Field3 => Empty_Node,
Field4 => Empty_Node,
Flag1 => False, Flag1 => False,
Flag2 => False, Flag2 => False,
Comments => Empty_Node); Comments => Empty_Node);
...@@ -447,6 +451,7 @@ package body Prj.Tree is ...@@ -447,6 +451,7 @@ package body Prj.Tree is
Field1 => Empty_Node, Field1 => Empty_Node,
Field2 => Empty_Node, Field2 => Empty_Node,
Field3 => Empty_Node, Field3 => Empty_Node,
Field4 => Empty_Node,
Flag1 => False, Flag1 => False,
Flag2 => False, Flag2 => False,
Comments => Empty_Node); Comments => Empty_Node);
...@@ -480,12 +485,13 @@ package body Prj.Tree is ...@@ -480,12 +485,13 @@ package body Prj.Tree is
Field1 => Empty_Node, Field1 => Empty_Node,
Field2 => Empty_Node, Field2 => Empty_Node,
Field3 => Empty_Node, Field3 => Empty_Node,
Field4 => Empty_Node,
Comments => Empty_Node); Comments => Empty_Node);
-- Link it to the N_Comment_Zones node, if it is the first, -- Link it to the N_Comment_Zones node, if it is the first,
-- otherwise to the previous one. -- otherwise to the previous one.
if Previous = Empty_Node then if No (Previous) then
In_Tree.Project_Nodes.Table (Zone).Field1 := In_Tree.Project_Nodes.Table (Zone).Field1 :=
Project_Node_Table.Last (In_Tree.Project_Nodes); Project_Node_Table.Last (In_Tree.Project_Nodes);
...@@ -518,7 +524,7 @@ package body Prj.Tree is ...@@ -518,7 +524,7 @@ package body Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Directory; return In_Tree.Project_Nodes.Table (Node).Directory;
...@@ -534,10 +540,10 @@ package body Prj.Tree is ...@@ -534,10 +540,10 @@ package body Prj.Tree is
Zone : Project_Node_Id := Empty_Node; Zone : Project_Node_Id := Empty_Node;
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments; Zone := In_Tree.Project_Nodes.Table (Node).Comments;
if Zone = Empty_Node then if No (Zone) then
return No_Name; return No_Name;
else else
return In_Tree.Project_Nodes.Table (Zone).Value; return In_Tree.Project_Nodes.Table (Zone).Value;
...@@ -553,7 +559,7 @@ package body Prj.Tree is ...@@ -553,7 +559,7 @@ package body Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Variable_Kind is In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else or else
...@@ -588,7 +594,7 @@ package body Prj.Tree is ...@@ -588,7 +594,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = (In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration N_Attribute_Declaration
...@@ -612,7 +618,7 @@ package body Prj.Tree is ...@@ -612,7 +618,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -628,7 +634,7 @@ package body Prj.Tree is ...@@ -628,7 +634,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value); return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
...@@ -643,7 +649,7 @@ package body Prj.Tree is ...@@ -643,7 +649,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field3; return In_Tree.Project_Nodes.Table (Node).Field3;
...@@ -659,7 +665,7 @@ package body Prj.Tree is ...@@ -659,7 +665,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -676,7 +682,7 @@ package body Prj.Tree is ...@@ -676,7 +682,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -692,7 +698,7 @@ package body Prj.Tree is ...@@ -692,7 +698,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -709,7 +715,7 @@ package body Prj.Tree is ...@@ -709,7 +715,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -725,10 +731,10 @@ package body Prj.Tree is ...@@ -725,10 +731,10 @@ package body Prj.Tree is
is is
Zone : Project_Node_Id := Empty_Node; Zone : Project_Node_Id := Empty_Node;
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments; Zone := In_Tree.Project_Nodes.Table (Node).Comments;
if Zone = Empty_Node then if No (Zone) then
return Empty_Node; return Empty_Node;
else else
...@@ -748,10 +754,10 @@ package body Prj.Tree is ...@@ -748,10 +754,10 @@ package body Prj.Tree is
Zone : Project_Node_Id := Empty_Node; Zone : Project_Node_Id := Empty_Node;
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments; Zone := In_Tree.Project_Nodes.Table (Node).Comments;
if Zone = Empty_Node then if No (Zone) then
return Empty_Node; return Empty_Node;
else else
...@@ -770,10 +776,10 @@ package body Prj.Tree is ...@@ -770,10 +776,10 @@ package body Prj.Tree is
Zone : Project_Node_Id := Empty_Node; Zone : Project_Node_Id := Empty_Node;
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments; Zone := In_Tree.Project_Nodes.Table (Node).Comments;
if Zone = Empty_Node then if No (Zone) then
return Empty_Node; return Empty_Node;
else else
...@@ -792,10 +798,10 @@ package body Prj.Tree is ...@@ -792,10 +798,10 @@ package body Prj.Tree is
Zone : Project_Node_Id := Empty_Node; Zone : Project_Node_Id := Empty_Node;
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments; Zone := In_Tree.Project_Nodes.Table (Node).Comments;
if Zone = Empty_Node then if No (Zone) then
return Empty_Node; return Empty_Node;
else else
...@@ -813,7 +819,7 @@ package body Prj.Tree is ...@@ -813,7 +819,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else or else
...@@ -838,7 +844,7 @@ package body Prj.Tree is ...@@ -838,7 +844,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -854,7 +860,7 @@ package body Prj.Tree is ...@@ -854,7 +860,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration); N_String_Type_Declaration);
...@@ -871,7 +877,7 @@ package body Prj.Tree is ...@@ -871,7 +877,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Packages; return In_Tree.Project_Nodes.Table (Node).Packages;
...@@ -887,7 +893,7 @@ package body Prj.Tree is ...@@ -887,7 +893,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field3; return In_Tree.Project_Nodes.Table (Node).Field3;
...@@ -903,7 +909,7 @@ package body Prj.Tree is ...@@ -903,7 +909,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -919,7 +925,7 @@ package body Prj.Tree is ...@@ -919,7 +925,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else or else
...@@ -938,7 +944,7 @@ package body Prj.Tree is ...@@ -938,7 +944,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -953,7 +959,7 @@ package body Prj.Tree is ...@@ -953,7 +959,7 @@ package body Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Boolean is In_Tree : Project_Node_Tree_Ref) return Boolean is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Flag1; return In_Tree.Project_Nodes.Table (Node).Flag1;
...@@ -988,7 +994,7 @@ package body Prj.Tree is ...@@ -988,7 +994,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Flag2; return In_Tree.Project_Nodes.Table (Node).Flag2;
...@@ -1003,7 +1009,7 @@ package body Prj.Tree is ...@@ -1003,7 +1009,7 @@ package body Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Boolean is In_Tree : Project_Node_Tree_Ref) return Boolean is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else or else
...@@ -1020,7 +1026,7 @@ package body Prj.Tree is ...@@ -1020,7 +1026,7 @@ package body Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Boolean is In_Tree : Project_Node_Tree_Ref) return Boolean is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
return In_Tree.Project_Nodes.Table (Node).Flag1; return In_Tree.Project_Nodes.Table (Node).Flag1;
...@@ -1042,27 +1048,27 @@ package body Prj.Tree is ...@@ -1042,27 +1048,27 @@ package body Prj.Tree is
begin begin
-- First check all the imported projects -- 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 -- Only non limited imported project may be used as prefix
-- of variable or attributes. -- of variable or attributes.
Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree); 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; and then Name_Of (Result, In_Tree) = With_Name;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop; end loop;
-- If it is not an imported project, it might be an extended project -- If it is not an imported project, it might be an extended project
if With_Clause = Empty_Node then if No (With_Clause) then
Result := Project; Result := Project;
loop loop
Result := Result :=
Extended_Project_Of Extended_Project_Of
(Project_Declaration_Of (Result, In_Tree), In_Tree); (Project_Declaration_Of (Result, In_Tree), In_Tree);
exit when Result = Empty_Node exit when No (Result)
or else Name_Of (Result, In_Tree) = With_Name; or else Name_Of (Result, In_Tree) = With_Name;
end loop; end loop;
end if; end if;
...@@ -1078,7 +1084,7 @@ package body Prj.Tree is ...@@ -1078,7 +1084,7 @@ package body Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Kind; return In_Tree.Project_Nodes.Table (Node).Kind;
end Kind_Of; end Kind_Of;
...@@ -1090,7 +1096,7 @@ package body Prj.Tree is ...@@ -1090,7 +1096,7 @@ package body Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Source_Ptr is In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Location; return In_Tree.Project_Nodes.Table (Node).Location;
end Location_Of; end Location_Of;
...@@ -1102,7 +1108,7 @@ package body Prj.Tree is ...@@ -1102,7 +1108,7 @@ package body Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id is In_Tree : Project_Node_Tree_Ref) return Name_Id is
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Name; return In_Tree.Project_Nodes.Table (Node).Name;
end Name_Of; end Name_Of;
...@@ -1116,7 +1122,7 @@ package body Prj.Tree is ...@@ -1116,7 +1122,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
return In_Tree.Project_Nodes.Table (Node).Field3; return In_Tree.Project_Nodes.Table (Node).Field3;
...@@ -1131,7 +1137,7 @@ package body Prj.Tree is ...@@ -1131,7 +1137,7 @@ package body Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Comments; return In_Tree.Project_Nodes.Table (Node).Comments;
...@@ -1147,7 +1153,7 @@ package body Prj.Tree is ...@@ -1147,7 +1153,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -1163,7 +1169,7 @@ package body Prj.Tree is ...@@ -1163,7 +1169,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -1180,7 +1186,7 @@ package body Prj.Tree is ...@@ -1180,7 +1186,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -1196,7 +1202,7 @@ package body Prj.Tree is ...@@ -1196,7 +1202,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field3; return In_Tree.Project_Nodes.Table (Node).Field3;
...@@ -1213,7 +1219,7 @@ package body Prj.Tree is ...@@ -1213,7 +1219,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration); N_String_Type_Declaration);
...@@ -1230,7 +1236,7 @@ package body Prj.Tree is ...@@ -1230,7 +1236,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term); In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -1247,7 +1253,7 @@ package body Prj.Tree is ...@@ -1247,7 +1253,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = (In_Tree.Project_Nodes.Table (Node).Kind =
N_Typed_Variable_Declaration N_Typed_Variable_Declaration
...@@ -1268,12 +1274,21 @@ package body Prj.Tree is ...@@ -1268,12 +1274,21 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
end Next_With_Clause_Of; 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 -- -- Non_Limited_Project_Node_Of --
--------------------------------- ---------------------------------
...@@ -1284,7 +1299,7 @@ package body Prj.Tree is ...@@ -1284,7 +1299,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
return In_Tree.Project_Nodes.Table (Node).Field3; return In_Tree.Project_Nodes.Table (Node).Field3;
...@@ -1300,7 +1315,7 @@ package body Prj.Tree is ...@@ -1300,7 +1315,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Pkg_Id; return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
...@@ -1316,7 +1331,7 @@ package body Prj.Tree is ...@@ -1316,7 +1331,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else or else
...@@ -1334,7 +1349,7 @@ package body Prj.Tree is ...@@ -1334,7 +1349,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else or else
...@@ -1342,6 +1357,15 @@ package body Prj.Tree is ...@@ -1342,6 +1357,15 @@ package body Prj.Tree is
return In_Tree.Project_Nodes.Table (Node).Path_Name; return In_Tree.Project_Nodes.Table (Node).Path_Name;
end Path_Name_Of; end Path_Name_Of;
-------------
-- Present --
-------------
function Present (Node : Project_Node_Id) return Boolean is
begin
return Node /= Empty_Node;
end Present;
---------------------------- ----------------------------
-- Project_Declaration_Of -- -- Project_Declaration_Of --
---------------------------- ----------------------------
...@@ -1352,7 +1376,7 @@ package body Prj.Tree is ...@@ -1352,7 +1376,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field2; return In_Tree.Project_Nodes.Table (Node).Field2;
...@@ -1368,12 +1392,28 @@ package body Prj.Tree is ...@@ -1368,12 +1392,28 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Qualifier; return In_Tree.Project_Nodes.Table (Node).Qualifier;
end Project_Qualifier_Of; 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 -- -- Project_File_Includes_Unkept_Comments --
------------------------------------------- -------------------------------------------
...@@ -1398,7 +1438,7 @@ package body Prj.Tree is ...@@ -1398,7 +1438,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else or else
...@@ -1418,7 +1458,7 @@ package body Prj.Tree is ...@@ -1418,7 +1458,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field1; return In_Tree.Project_Nodes.Table (Node).Field1;
...@@ -1534,7 +1574,7 @@ package body Prj.Tree is ...@@ -1534,7 +1574,7 @@ package body Prj.Tree is
-- an end of line node specified, associate the comment with -- an end of line node specified, associate the comment with
-- this node. -- this node.
elsif End_Of_Line_Node /= Empty_Node then elsif Present (End_Of_Line_Node) then
declare declare
Zones : constant Project_Node_Id := Zones : constant Project_Node_Id :=
Comment_Zones_Of (End_Of_Line_Node, In_Tree); Comment_Zones_Of (End_Of_Line_Node, In_Tree);
...@@ -1559,13 +1599,13 @@ package body Prj.Tree is ...@@ -1559,13 +1599,13 @@ package body Prj.Tree is
if Comments.Last > 0 and then if Comments.Last > 0 and then
not Comments.Table (1).Follows_Empty_Line then not Comments.Table (1).Follows_Empty_Line then
if Previous_Line_Node /= Empty_Node then if Present (Previous_Line_Node) then
Add_Comments Add_Comments
(To => Previous_Line_Node, (To => Previous_Line_Node,
Where => After, Where => After,
In_Tree => In_Tree); In_Tree => In_Tree);
elsif Previous_End_Node /= Empty_Node then elsif Present (Previous_End_Node) then
Add_Comments Add_Comments
(To => Previous_End_Node, (To => Previous_End_Node,
Where => After_End, Where => After_End,
...@@ -1617,7 +1657,7 @@ package body Prj.Tree is ...@@ -1617,7 +1657,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else or else
...@@ -1636,7 +1676,7 @@ package body Prj.Tree is ...@@ -1636,7 +1676,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To; In_Tree.Project_Nodes.Table (Node).Field3 := To;
...@@ -1653,7 +1693,7 @@ package body Prj.Tree is ...@@ -1653,7 +1693,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = (In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration)); N_Attribute_Declaration));
...@@ -1671,7 +1711,7 @@ package body Prj.Tree is ...@@ -1671,7 +1711,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else or else
...@@ -1690,7 +1730,7 @@ package body Prj.Tree is ...@@ -1690,7 +1730,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -1707,7 +1747,7 @@ package body Prj.Tree is ...@@ -1707,7 +1747,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -1724,7 +1764,7 @@ package body Prj.Tree is ...@@ -1724,7 +1764,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term); In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -1741,7 +1781,7 @@ package body Prj.Tree is ...@@ -1741,7 +1781,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Directory := To; In_Tree.Project_Nodes.Table (Node).Directory := To;
...@@ -1767,7 +1807,7 @@ package body Prj.Tree is ...@@ -1767,7 +1807,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else or else
...@@ -1802,7 +1842,7 @@ package body Prj.Tree is ...@@ -1802,7 +1842,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = (In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration N_Attribute_Declaration
...@@ -1826,7 +1866,7 @@ package body Prj.Tree is ...@@ -1826,7 +1866,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -1843,7 +1883,7 @@ package body Prj.Tree is ...@@ -1843,7 +1883,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -1860,7 +1900,7 @@ package body Prj.Tree is ...@@ -1860,7 +1900,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -1877,7 +1917,7 @@ package body Prj.Tree is ...@@ -1877,7 +1917,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -1951,7 +1991,7 @@ package body Prj.Tree is ...@@ -1951,7 +1991,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
In_Tree.Project_Nodes.Table (Node).Field3 := To; In_Tree.Project_Nodes.Table (Node).Field3 := To;
...@@ -1968,7 +2008,7 @@ package body Prj.Tree is ...@@ -1968,7 +2008,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
In_Tree.Project_Nodes.Table (Node).Comments := To; In_Tree.Project_Nodes.Table (Node).Comments := To;
...@@ -1985,7 +2025,7 @@ package body Prj.Tree is ...@@ -1985,7 +2025,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else or else
...@@ -2011,7 +2051,7 @@ package body Prj.Tree is ...@@ -2011,7 +2051,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -2028,7 +2068,7 @@ package body Prj.Tree is ...@@ -2028,7 +2068,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration); N_String_Type_Declaration);
...@@ -2046,7 +2086,7 @@ package body Prj.Tree is ...@@ -2046,7 +2086,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Packages := To; In_Tree.Project_Nodes.Table (Node).Packages := To;
...@@ -2063,7 +2103,7 @@ package body Prj.Tree is ...@@ -2063,7 +2103,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field3 := To; In_Tree.Project_Nodes.Table (Node).Field3 := To;
...@@ -2080,7 +2120,7 @@ package body Prj.Tree is ...@@ -2080,7 +2120,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -2097,7 +2137,7 @@ package body Prj.Tree is ...@@ -2097,7 +2137,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else or else
...@@ -2116,7 +2156,7 @@ package body Prj.Tree is ...@@ -2116,7 +2156,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -2132,7 +2172,7 @@ package body Prj.Tree is ...@@ -2132,7 +2172,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else or else
...@@ -2150,7 +2190,7 @@ package body Prj.Tree is ...@@ -2150,7 +2190,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
In_Tree.Project_Nodes.Table (Node).Flag1 := True; In_Tree.Project_Nodes.Table (Node).Flag1 := True;
...@@ -2166,7 +2206,7 @@ package body Prj.Tree is ...@@ -2166,7 +2206,7 @@ package body Prj.Tree is
To : Project_Node_Kind) To : Project_Node_Kind)
is is
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Kind := To; In_Tree.Project_Nodes.Table (Node).Kind := To;
end Set_Kind_Of; end Set_Kind_Of;
...@@ -2180,7 +2220,7 @@ package body Prj.Tree is ...@@ -2180,7 +2220,7 @@ package body Prj.Tree is
To : Source_Ptr) To : Source_Ptr)
is is
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Location := To; In_Tree.Project_Nodes.Table (Node).Location := To;
end Set_Location_Of; end Set_Location_Of;
...@@ -2195,7 +2235,7 @@ package body Prj.Tree is ...@@ -2195,7 +2235,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -2212,7 +2252,7 @@ package body Prj.Tree is ...@@ -2212,7 +2252,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To); In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
...@@ -2229,7 +2269,7 @@ package body Prj.Tree is ...@@ -2229,7 +2269,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To; In_Tree.Project_Nodes.Table (Node).Field3 := To;
...@@ -2245,7 +2285,7 @@ package body Prj.Tree is ...@@ -2245,7 +2285,7 @@ package body Prj.Tree is
To : Name_Id) To : Name_Id)
is is
begin begin
pragma Assert (Node /= Empty_Node); pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Name := To; In_Tree.Project_Nodes.Table (Node).Name := To;
end Set_Name_Of; end Set_Name_Of;
...@@ -2260,7 +2300,7 @@ package body Prj.Tree is ...@@ -2260,7 +2300,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -2287,7 +2327,7 @@ package body Prj.Tree is ...@@ -2287,7 +2327,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -2304,7 +2344,7 @@ package body Prj.Tree is ...@@ -2304,7 +2344,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -2321,7 +2361,7 @@ package body Prj.Tree is ...@@ -2321,7 +2361,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To; In_Tree.Project_Nodes.Table (Node).Field3 := To;
...@@ -2338,7 +2378,7 @@ package body Prj.Tree is ...@@ -2338,7 +2378,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration); N_String_Type_Declaration);
...@@ -2356,7 +2396,7 @@ package body Prj.Tree is ...@@ -2356,7 +2396,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term); In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -2373,7 +2413,7 @@ package body Prj.Tree is ...@@ -2373,7 +2413,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = (In_Tree.Project_Nodes.Table (Node).Kind =
N_Typed_Variable_Declaration N_Typed_Variable_Declaration
...@@ -2394,7 +2434,7 @@ package body Prj.Tree is ...@@ -2394,7 +2434,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -2411,7 +2451,7 @@ package body Prj.Tree is ...@@ -2411,7 +2451,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Pkg_Id := To; In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
...@@ -2428,7 +2468,7 @@ package body Prj.Tree is ...@@ -2428,7 +2468,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else or else
...@@ -2447,7 +2487,7 @@ package body Prj.Tree is ...@@ -2447,7 +2487,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else or else
...@@ -2483,7 +2523,7 @@ package body Prj.Tree is ...@@ -2483,7 +2523,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field2 := To; In_Tree.Project_Nodes.Table (Node).Field2 := To;
...@@ -2500,11 +2540,27 @@ package body Prj.Tree is ...@@ -2500,11 +2540,27 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Qualifier := To; In_Tree.Project_Nodes.Table (Node).Qualifier := To;
end Set_Project_Qualifier_Of; 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 -- -- Set_Project_File_Includes_Unkept_Comments --
----------------------------------------------- -----------------------------------------------
...@@ -2532,7 +2588,7 @@ package body Prj.Tree is ...@@ -2532,7 +2588,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else or else
...@@ -2559,7 +2615,7 @@ package body Prj.Tree is ...@@ -2559,7 +2615,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Field1 := To; In_Tree.Project_Nodes.Table (Node).Field1 := To;
...@@ -2576,7 +2632,7 @@ package body Prj.Tree is ...@@ -2576,7 +2632,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else or else
...@@ -2596,7 +2652,7 @@ package body Prj.Tree is ...@@ -2596,7 +2652,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = (In_Tree.Project_Nodes.Table (Node).Kind =
N_Variable_Reference N_Variable_Reference
...@@ -2624,7 +2680,7 @@ package body Prj.Tree is ...@@ -2624,7 +2680,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else or else
...@@ -2644,7 +2700,7 @@ package body Prj.Tree is ...@@ -2644,7 +2700,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else or else
...@@ -2663,7 +2719,7 @@ package body Prj.Tree is ...@@ -2663,7 +2719,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = (In_Tree.Project_Nodes.Table (Node).Kind =
N_Variable_Reference N_Variable_Reference
...@@ -2688,7 +2744,7 @@ package body Prj.Tree is ...@@ -2688,7 +2744,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(Node /= Empty_Node (Present (Node)
and then and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else or else
...@@ -2709,7 +2765,7 @@ package body Prj.Tree is ...@@ -2709,7 +2765,7 @@ package body Prj.Tree is
is is
begin begin
pragma Assert pragma Assert
(For_Typed_Variable /= Empty_Node (Present (For_Typed_Variable)
and then and then
(In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind = (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
N_Typed_Variable_Declaration)); N_Typed_Variable_Declaration));
...@@ -2721,7 +2777,7 @@ package body Prj.Tree is ...@@ -2721,7 +2777,7 @@ package body Prj.Tree is
In_Tree); In_Tree);
begin begin
while Current_String /= Empty_Node while Present (Current_String)
and then and then
String_Value_Of (Current_String, In_Tree) /= Value String_Value_Of (Current_String, In_Tree) /= Value
loop loop
...@@ -2729,7 +2785,7 @@ package body Prj.Tree is ...@@ -2729,7 +2785,7 @@ package body Prj.Tree is
Next_Literal_String (Current_String, In_Tree); Next_Literal_String (Current_String, In_Tree);
end loop; end loop;
return Current_String /= Empty_Node; return Present (Current_String);
end; end;
end Value_Is_Valid; end Value_Is_Valid;
......
gcc/ada/prj-tree.ads
...@@ -90,6 +90,14 @@ package Prj.Tree is ...@@ -90,6 +90,14 @@ package Prj.Tree is
-- of the fields in each node of Project_Node_Kind, look at package -- of the fields in each node of Project_Node_Kind, look at package
-- Tree_Private_Part. -- Tree_Private_Part.
function Present (Node : Project_Node_Id) return Boolean;
pragma Inline (Present);
-- Return True iff Node /= Empty_Node
function No (Node : Project_Node_Id) return Boolean;
pragma Inline (No);
-- Return True iff Node = Empty_Node
procedure Initialize (Tree : Project_Node_Tree_Ref); procedure Initialize (Tree : Project_Node_Tree_Ref);
-- Initialize the Project File tree: empty the Project_Nodes table -- Initialize the Project File tree: empty the Project_Nodes table
-- and reset the Projects_Htable. -- and reset the Projects_Htable.
...@@ -262,10 +270,15 @@ package Prj.Tree is ...@@ -262,10 +270,15 @@ package Prj.Tree is
In_Tree : Project_Node_Tree_Ref) return Boolean; In_Tree : Project_Node_Tree_Ref) return Boolean;
-- Valid only for N_Comment nodes -- Valid only for N_Comment nodes
function Parent_Project_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Parent_Project_Of);
-- Valid only for N_Project nodes
function Project_File_Includes_Unkept_Comments function Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) In_Tree : Project_Node_Tree_Ref) return Boolean;
return Boolean;
-- Valid only for N_Project nodes -- Valid only for N_Project nodes
function Directory_Of function Directory_Of
...@@ -631,6 +644,11 @@ package Prj.Tree is ...@@ -631,6 +644,11 @@ package Prj.Tree is
To : Project_Node_Id); To : Project_Node_Id);
pragma Inline (Set_Next_Comment); pragma Inline (Set_Next_Comment);
procedure Set_Parent_Project_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
procedure Set_Project_File_Includes_Unkept_Comments procedure Set_Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref; In_Tree : Project_Node_Tree_Ref;
...@@ -972,6 +990,9 @@ package Prj.Tree is ...@@ -972,6 +990,9 @@ package Prj.Tree is
Field3 : Project_Node_Id := Empty_Node; Field3 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind -- See below the meaning for each Project_Node_Kind
Field4 : Project_Node_Id := Empty_Node;
-- See below the meaning for each Project_Node_Kind
Flag1 : Boolean := False; Flag1 : Boolean := False;
-- This flag is significant only for: -- This flag is significant only for:
-- N_Attribute_Declaration and N_Attribute_Reference -- N_Attribute_Declaration and N_Attribute_Reference
...@@ -1019,6 +1040,7 @@ package Prj.Tree is ...@@ -1019,6 +1040,7 @@ package Prj.Tree is
-- -- Field1: first with clause -- -- Field1: first with clause
-- -- Field2: project declaration -- -- Field2: project declaration
-- -- Field3: first string type -- -- Field3: first string type
-- -- Field4: parent project, if any
-- -- Value: extended project path name (if any) -- -- Value: extended project path name (if any)
-- N_With_Clause, -- N_With_Clause,
...@@ -1028,6 +1050,7 @@ package Prj.Tree is ...@@ -1028,6 +1050,7 @@ package Prj.Tree is
-- -- Field1: project node -- -- Field1: project node
-- -- Field2: next with clause -- -- Field2: next with clause
-- -- Field3: project node or empty if "limited with" -- -- Field3: project node or empty if "limited with"
-- -- Field4: not used
-- -- Value: literal string withed -- -- Value: literal string withed
-- N_Project_Declaration, -- N_Project_Declaration,
...@@ -1037,6 +1060,7 @@ package Prj.Tree is ...@@ -1037,6 +1060,7 @@ package Prj.Tree is
-- -- Field1: first declarative item -- -- Field1: first declarative item
-- -- Field2: extended project -- -- Field2: extended project
-- -- Field3: extending project -- -- Field3: extending project
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Declarative_Item, -- N_Declarative_Item,
...@@ -1046,6 +1070,7 @@ package Prj.Tree is ...@@ -1046,6 +1070,7 @@ package Prj.Tree is
-- -- Field1: current item node -- -- Field1: current item node
-- -- Field2: next declarative item -- -- Field2: next declarative item
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Package_Declaration, -- N_Package_Declaration,
...@@ -1055,6 +1080,7 @@ package Prj.Tree is ...@@ -1055,6 +1080,7 @@ package Prj.Tree is
-- -- Field1: project of renamed package (if any) -- -- Field1: project of renamed package (if any)
-- -- Field2: first declarative item -- -- Field2: first declarative item
-- -- Field3: next package in project -- -- Field3: next package in project
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_String_Type_Declaration, -- N_String_Type_Declaration,
...@@ -1064,6 +1090,7 @@ package Prj.Tree is ...@@ -1064,6 +1090,7 @@ package Prj.Tree is
-- -- Field1: first literal string -- -- Field1: first literal string
-- -- Field2: next string type -- -- Field2: next string type
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Literal_String, -- N_Literal_String,
...@@ -1073,6 +1100,7 @@ package Prj.Tree is ...@@ -1073,6 +1100,7 @@ package Prj.Tree is
-- -- Field1: next literal string -- -- Field1: next literal string
-- -- Field2: not used -- -- Field2: not used
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: string value -- -- Value: string value
-- N_Attribute_Declaration, -- N_Attribute_Declaration,
...@@ -1082,6 +1110,7 @@ package Prj.Tree is ...@@ -1082,6 +1110,7 @@ package Prj.Tree is
-- -- Field1: expression -- -- Field1: expression
-- -- Field2: project of full associative array -- -- Field2: project of full associative array
-- -- Field3: package of full associative array -- -- Field3: package of full associative array
-- -- Field4: not used
-- -- Value: associative array index -- -- Value: associative array index
-- -- (if an associative array element) -- -- (if an associative array element)
...@@ -1092,6 +1121,7 @@ package Prj.Tree is ...@@ -1092,6 +1121,7 @@ package Prj.Tree is
-- -- Field1: expression -- -- Field1: expression
-- -- Field2: type of variable (N_String_Type_Declaration) -- -- Field2: type of variable (N_String_Type_Declaration)
-- -- Field3: next variable -- -- Field3: next variable
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Variable_Declaration, -- N_Variable_Declaration,
...@@ -1105,6 +1135,7 @@ package Prj.Tree is ...@@ -1105,6 +1135,7 @@ package Prj.Tree is
-- -- N_Variable_Declaration and -- -- N_Variable_Declaration and
-- -- N_Typed_Variable_Declaration -- -- N_Typed_Variable_Declaration
-- -- Field3: next variable -- -- Field3: next variable
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Expression, -- N_Expression,
...@@ -1123,6 +1154,7 @@ package Prj.Tree is ...@@ -1123,6 +1154,7 @@ package Prj.Tree is
-- -- Field1: current term -- -- Field1: current term
-- -- Field2: next term in the expression -- -- Field2: next term in the expression
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Literal_String_List, -- N_Literal_String_List,
...@@ -1135,6 +1167,7 @@ package Prj.Tree is ...@@ -1135,6 +1167,7 @@ package Prj.Tree is
-- -- Field1: first expression -- -- Field1: first expression
-- -- Field2: not used -- -- Field2: not used
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Variable_Reference, -- N_Variable_Reference,
...@@ -1144,6 +1177,7 @@ package Prj.Tree is ...@@ -1144,6 +1177,7 @@ package Prj.Tree is
-- -- Field1: project (if specified) -- -- Field1: project (if specified)
-- -- Field2: package (if specified) -- -- Field2: package (if specified)
-- -- Field3: type of variable (N_String_Type_Declaration), if any -- -- Field3: type of variable (N_String_Type_Declaration), if any
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_External_Value, -- N_External_Value,
...@@ -1162,6 +1196,7 @@ package Prj.Tree is ...@@ -1162,6 +1196,7 @@ package Prj.Tree is
-- -- Field1: project -- -- Field1: project
-- -- Field2: package (if attribute of a package) -- -- Field2: package (if attribute of a package)
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: associative array index -- -- Value: associative array index
-- -- (if an associative array element) -- -- (if an associative array element)
...@@ -1172,6 +1207,7 @@ package Prj.Tree is ...@@ -1172,6 +1207,7 @@ package Prj.Tree is
-- -- Field1: case variable reference -- -- Field1: case variable reference
-- -- Field2: first case item -- -- Field2: first case item
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Case_Item -- N_Case_Item
...@@ -1182,6 +1218,7 @@ package Prj.Tree is ...@@ -1182,6 +1218,7 @@ package Prj.Tree is
-- -- for when others -- -- for when others
-- -- Field2: first declarative item -- -- Field2: first declarative item
-- -- Field3: next case item -- -- Field3: next case item
-- -- Field4: not used
-- -- Value: not used -- -- Value: not used
-- N_Comment_zones -- N_Comment_zones
...@@ -1192,6 +1229,7 @@ package Prj.Tree is ...@@ -1192,6 +1229,7 @@ package Prj.Tree is
-- -- Field2: comment after the construct -- -- Field2: comment after the construct
-- -- Field3: comment before the "end" of the construct -- -- Field3: comment before the "end" of the construct
-- -- Value: end of line comment -- -- Value: end of line comment
-- -- Field4: not used
-- -- Comments: comment after the "end" of the construct -- -- Comments: comment after the "end" of the construct
-- N_Comment -- N_Comment
...@@ -1201,6 +1239,7 @@ package Prj.Tree is ...@@ -1201,6 +1239,7 @@ package Prj.Tree is
-- -- Field1: not used -- -- Field1: not used
-- -- Field2: not used -- -- Field2: not used
-- -- Field3: not used -- -- Field3: not used
-- -- Field4: not used
-- -- Value: comment -- -- Value: comment
-- -- Flag1: comment is preceded by an empty line -- -- Flag1: comment is preceded by an empty line
-- -- Flag2: comment is followed by an empty line -- -- Flag2: comment is followed by an empty line
...@@ -1229,13 +1268,17 @@ package Prj.Tree is ...@@ -1229,13 +1268,17 @@ package Prj.Tree is
Extended : Boolean; Extended : Boolean;
-- True when the project is being extended by another project -- True when the project is being extended by another project
Proj_Qualifier : Project_Qualifier;
-- The project qualifier of the project, if any
end record; end record;
No_Project_Name_And_Node : constant Project_Name_And_Node := No_Project_Name_And_Node : constant Project_Name_And_Node :=
(Name => No_Name, (Name => No_Name,
Node => Empty_Node, Node => Empty_Node,
Canonical_Path => No_Path, Canonical_Path => No_Path,
Extended => True); Extended => True,
Proj_Qualifier => Unspecified);
package Projects_Htable is new GNAT.Dynamic_HTables.Simple_HTable package Projects_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
......
gcc/ada/prj.adb
...@@ -122,6 +122,7 @@ package body Prj is ...@@ -122,6 +122,7 @@ package body Prj is
Sources => Nil_String, Sources => Nil_String,
First_Source => No_Source, First_Source => No_Source,
Last_Source => No_Source, Last_Source => No_Source,
Interfaces_Defined => False,
Unit_Based_Language_Name => No_Name, Unit_Based_Language_Name => No_Name,
Unit_Based_Language_Index => No_Language_Index, Unit_Based_Language_Index => No_Language_Index,
Imported_Directories_Switches => null, Imported_Directories_Switches => null,
...@@ -599,6 +600,11 @@ package body Prj is ...@@ -599,6 +600,11 @@ package body Prj is
return Hash (Get_Name_String (Name)); return Hash (Get_Name_String (Name));
end Hash; end Hash;
function Hash (Project : Project_Id) return Header_Num is
begin
return Header_Num (Project mod Max_Header_Num);
end Hash;
----------- -----------
-- Image -- -- Image --
----------- -----------
......
gcc/ada/prj.ads
...@@ -307,7 +307,8 @@ package Prj is ...@@ -307,7 +307,8 @@ package Prj is
Language : Language_Index); Language : Language_Index);
-- Output the name of a language -- Output the name of a language
type Header_Num is range 0 .. 6150; Max_Header_Num : constant := 6150;
type Header_Num is range 0 .. Max_Header_Num;
-- Size for hash table below. The upper bound is an arbitrary value, the -- Size for hash table below. The upper bound is an arbitrary value, the
-- value here was chosen after testing to determine a good compromise -- value here was chosen after testing to determine a good compromise
-- between speed of access and memory usage. -- between speed of access and memory usage.
...@@ -317,6 +318,9 @@ package Prj is ...@@ -317,6 +318,9 @@ package Prj is
function Hash (Name : Path_Name_Type) return Header_Num; function Hash (Name : Path_Name_Type) return Header_Num;
-- Used for computing hash values for names put into above hash table -- Used for computing hash values for names put into above hash table
function Hash (Project : Project_Id) return Header_Num;
-- Used for hash tables where Project_Id is the Key
type Language_Kind is (File_Based, Unit_Based); type Language_Kind is (File_Based, Unit_Based);
-- Type for the kind of language. All languages are file based, except Ada -- Type for the kind of language. All languages are file based, except Ada
-- which is unit based. -- which is unit based.
...@@ -420,6 +424,13 @@ package Prj is ...@@ -420,6 +424,13 @@ package Prj is
-- shared libraries. Specified in the configuration. When not specified, -- shared libraries. Specified in the configuration. When not specified,
-- there is no need for such switch. -- there is no need for such switch.
Object_Generated : Boolean := True;
-- False in no object file is generated
Objects_Linked : Boolean := True;
-- False if object files are not use to link executables and build
-- libraries.
Runtime_Library_Dir : Name_Id := No_Name; Runtime_Library_Dir : Name_Id := No_Name;
-- Path name of the runtime library directory, if any -- Path name of the runtime library directory, if any
...@@ -527,6 +538,8 @@ package Prj is ...@@ -527,6 +538,8 @@ package Prj is
Compiler_Driver_Path => null, Compiler_Driver_Path => null,
Compiler_Required_Switches => No_Name_List, Compiler_Required_Switches => No_Name_List,
Compilation_PIC_Option => No_Name_List, Compilation_PIC_Option => No_Name_List,
Object_Generated => True,
Objects_Linked => True,
Runtime_Library_Dir => No_Name, Runtime_Library_Dir => No_Name,
Mapping_File_Switches => No_Name_List, Mapping_File_Switches => No_Name_List,
Mapping_Spec_Suffix => No_File, Mapping_Spec_Suffix => No_File,
...@@ -616,6 +629,13 @@ package Prj is ...@@ -616,6 +629,13 @@ package Prj is
Compiled : Boolean := True; Compiled : Boolean := True;
-- False when there is no compiler for the language -- False when there is no compiler for the language
In_Interfaces : Boolean := True;
-- False when the source is not included in interfaces, when attribute
-- Interfaces is declared.
Declared_In_Interfaces : Boolean := False;
-- True when source is declared in attribute Interfaces
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language; Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
-- List of languages a header file may also be, in addition of -- List of languages a header file may also be, in addition of
-- language Language_Name. -- language Language_Name.
...@@ -667,6 +687,10 @@ package Prj is ...@@ -667,6 +687,10 @@ package Prj is
Object_Exists : Boolean := True; Object_Exists : Boolean := True;
-- True if an object file exists -- True if an object file exists
Object_Linked : Boolean := True;
-- False if the object file is not use to link executables or included
-- in libraries.
Object : File_Name_Type := No_File; Object : File_Name_Type := No_File;
-- File name of the object file -- File name of the object file
...@@ -714,42 +738,45 @@ package Prj is ...@@ -714,42 +738,45 @@ package Prj is
end record; end record;
No_Source_Data : constant Source_Data := No_Source_Data : constant Source_Data :=
(Project => No_Project, (Project => No_Project,
Language_Name => No_Name, Language_Name => No_Name,
Language => No_Language_Index, Language => No_Language_Index,
Lang_Kind => File_Based, Lang_Kind => File_Based,
Compiled => True, Compiled => True,
Alternate_Languages => No_Alternate_Language, In_Interfaces => True,
Kind => Spec, Declared_In_Interfaces => False,
Dependency => None, Alternate_Languages => No_Alternate_Language,
Other_Part => No_Source, Kind => Spec,
Unit => No_Name, Dependency => None,
Index => 0, Other_Part => No_Source,
Locally_Removed => False, Unit => No_Name,
Get_Object => False, Index => 0,
Replaced_By => No_Source, Locally_Removed => False,
File => No_File, Get_Object => False,
Display_File => No_File, Replaced_By => No_Source,
Path => No_Path, File => No_File,
Display_Path => No_Path, Display_File => No_File,
Source_TS => Empty_Time_Stamp, Path => No_Path,
Object_Project => No_Project, Display_Path => No_Path,
Object_Exists => True, Source_TS => Empty_Time_Stamp,
Object => No_File, Object_Project => No_Project,
Current_Object_Path => No_Path, Object_Exists => True,
Object_Path => No_Path, Object_Linked => True,
Object_TS => Empty_Time_Stamp, Object => No_File,
Dep_Name => No_File, Current_Object_Path => No_Path,
Current_Dep_Path => No_Path, Object_Path => No_Path,
Dep_Path => No_Path, Object_TS => Empty_Time_Stamp,
Dep_TS => Empty_Time_Stamp, Dep_Name => No_File,
Switches => No_File, Current_Dep_Path => No_Path,
Switches_Path => No_Path, Dep_Path => No_Path,
Switches_TS => Empty_Time_Stamp, Dep_TS => Empty_Time_Stamp,
Naming_Exception => False, Switches => No_File,
Next_In_Sources => No_Source, Switches_Path => No_Path,
Next_In_Project => No_Source, Switches_TS => Empty_Time_Stamp,
Next_In_Lang => No_Source); Naming_Exception => False,
Next_In_Sources => No_Source,
Next_In_Project => No_Source,
Next_In_Lang => No_Source);
package Source_Data_Table is new GNAT.Dynamic_Tables package Source_Data_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Source_Data, (Table_Component_Type => Source_Data,
...@@ -1267,9 +1294,6 @@ package Prj is ...@@ -1267,9 +1294,6 @@ package Prj is
Dir_Path : String_Access; Dir_Path : String_Access;
-- Same as Directory, but as an access to String -- Same as Directory, but as an access to String
Library : Boolean := False;
-- True if this is a library project
Library_Dir : Path_Name_Type := No_Path; Library_Dir : Path_Name_Type := No_Path;
-- If a library project, path name of the directory where the library -- If a library project, path name of the directory where the library
-- resides. -- resides.
...@@ -1303,6 +1327,9 @@ package Prj is ...@@ -1303,6 +1327,9 @@ package Prj is
-- be different from Library_ALI_Dir for platforms where the file names -- be different from Library_ALI_Dir for platforms where the file names
-- are case-insensitive. -- are case-insensitive.
Library : Boolean := False;
-- True if this is a library project
Library_Name : Name_Id := No_Name; Library_Name : Name_Id := No_Name;
-- If a library project, name of the library -- If a library project, name of the library
...@@ -1339,6 +1366,10 @@ package Prj is ...@@ -1339,6 +1366,10 @@ package Prj is
Last_Source : Source_Id := No_Source; Last_Source : Source_Id := No_Source;
-- Head and tail of the list of sources -- Head and tail of the list of sources
Interfaces_Defined : Boolean := False;
-- True if attribute Interfaces is declared for the project or any
-- project it extends.
Unit_Based_Language_Name : Name_Id := No_Name; Unit_Based_Language_Name : Name_Id := No_Name;
Unit_Based_Language_Index : Language_Index := No_Language_Index; Unit_Based_Language_Index : Language_Index := No_Language_Index;
-- The name and index, if any, of the unit-based language of some -- The name and index, if any, of the unit-based language of some
......
gcc/ada/snames.adb
...@@ -771,6 +771,8 @@ package body Snames is ...@@ -771,6 +771,8 @@ package body Snames is
"mapping_body_suffix#" & "mapping_body_suffix#" &
"metrics#" & "metrics#" &
"naming#" & "naming#" &
"object_generated#" &
"objects_linked#" &
"objects_path#" & "objects_path#" &
"objects_path_file#" & "objects_path_file#" &
"object_dir#" & "object_dir#" &
......
gcc/ada/snames.ads
...@@ -1092,56 +1092,58 @@ package Snames is ...@@ -1092,56 +1092,58 @@ package Snames is
Name_Mapping_Body_Suffix : constant Name_Id := N + 710; Name_Mapping_Body_Suffix : constant Name_Id := N + 710;
Name_Metrics : constant Name_Id := N + 711; Name_Metrics : constant Name_Id := N + 711;
Name_Naming : constant Name_Id := N + 712; Name_Naming : constant Name_Id := N + 712;
Name_Objects_Path : constant Name_Id := N + 713; Name_Object_Generated : constant Name_Id := N + 713;
Name_Objects_Path_File : constant Name_Id := N + 714; Name_Objects_Linked : constant Name_Id := N + 714;
Name_Object_Dir : constant Name_Id := N + 715; Name_Objects_Path : constant Name_Id := N + 715;
Name_Pic_Option : constant Name_Id := N + 716; Name_Objects_Path_File : constant Name_Id := N + 716;
Name_Pretty_Printer : constant Name_Id := N + 717; Name_Object_Dir : constant Name_Id := N + 717;
Name_Prefix : constant Name_Id := N + 718; Name_Pic_Option : constant Name_Id := N + 718;
Name_Project : constant Name_Id := N + 719; Name_Pretty_Printer : constant Name_Id := N + 719;
Name_Roots : constant Name_Id := N + 720; Name_Prefix : constant Name_Id := N + 720;
Name_Required_Switches : constant Name_Id := N + 721; Name_Project : constant Name_Id := N + 721;
Name_Run_Path_Option : constant Name_Id := N + 722; Name_Roots : constant Name_Id := N + 722;
Name_Runtime_Project : constant Name_Id := N + 723; Name_Required_Switches : constant Name_Id := N + 723;
Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 724; Name_Run_Path_Option : constant Name_Id := N + 724;
Name_Shared_Library_Prefix : constant Name_Id := N + 725; Name_Runtime_Project : constant Name_Id := N + 725;
Name_Shared_Library_Suffix : constant Name_Id := N + 726; Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 726;
Name_Separate_Suffix : constant Name_Id := N + 727; Name_Shared_Library_Prefix : constant Name_Id := N + 727;
Name_Source_Dirs : constant Name_Id := N + 728; Name_Shared_Library_Suffix : constant Name_Id := N + 728;
Name_Source_Files : constant Name_Id := N + 729; Name_Separate_Suffix : constant Name_Id := N + 729;
Name_Source_List_File : constant Name_Id := N + 730; Name_Source_Dirs : constant Name_Id := N + 730;
Name_Spec : constant Name_Id := N + 731; Name_Source_Files : constant Name_Id := N + 731;
Name_Spec_Suffix : constant Name_Id := N + 732; Name_Source_List_File : constant Name_Id := N + 732;
Name_Specification : constant Name_Id := N + 733; Name_Spec : constant Name_Id := N + 733;
Name_Specification_Exceptions : constant Name_Id := N + 734; Name_Spec_Suffix : constant Name_Id := N + 734;
Name_Specification_Suffix : constant Name_Id := N + 735; Name_Specification : constant Name_Id := N + 735;
Name_Stack : constant Name_Id := N + 736; Name_Specification_Exceptions : constant Name_Id := N + 736;
Name_Switches : constant Name_Id := N + 737; Name_Specification_Suffix : constant Name_Id := N + 737;
Name_Symbolic_Link_Supported : constant Name_Id := N + 738; Name_Stack : constant Name_Id := N + 738;
Name_Sync : constant Name_Id := N + 739; Name_Switches : constant Name_Id := N + 739;
Name_Synchronize : constant Name_Id := N + 740; Name_Symbolic_Link_Supported : constant Name_Id := N + 740;
Name_Toolchain_Description : constant Name_Id := N + 741; Name_Sync : constant Name_Id := N + 741;
Name_Toolchain_Version : constant Name_Id := N + 742; Name_Synchronize : constant Name_Id := N + 742;
Name_Runtime_Library_Dir : constant Name_Id := N + 743; Name_Toolchain_Description : constant Name_Id := N + 743;
Name_Toolchain_Version : constant Name_Id := N + 744;
Name_Runtime_Library_Dir : constant Name_Id := N + 745;
-- Other miscellaneous names used in front end -- Other miscellaneous names used in front end
Name_Unaligned_Valid : constant Name_Id := N + 744; Name_Unaligned_Valid : constant Name_Id := N + 746;
-- Ada 2005 reserved words -- Ada 2005 reserved words
First_2005_Reserved_Word : constant Name_Id := N + 745; First_2005_Reserved_Word : constant Name_Id := N + 747;
Name_Interface : constant Name_Id := N + 745; Name_Interface : constant Name_Id := N + 747;
Name_Overriding : constant Name_Id := N + 746; Name_Overriding : constant Name_Id := N + 748;
Name_Synchronized : constant Name_Id := N + 747; Name_Synchronized : constant Name_Id := N + 749;
Last_2005_Reserved_Word : constant Name_Id := N + 747; Last_2005_Reserved_Word : constant Name_Id := N + 749;
subtype Ada_2005_Reserved_Words is subtype Ada_2005_Reserved_Words is
Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word; Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
-- Mark last defined name for consistency check in Snames body -- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 747; Last_Predefined_Name : constant Name_Id := N + 749;
--------------------------------------- ---------------------------------------
-- Subtypes Defining Name Categories -- -- Subtypes Defining Name Categories --
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment