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