"LVlocally_removed_files#" &
"LVexcluded_source_files#" &
"SVsource_list_file#" &
+ "LVinterfaces#" &
-- Libraries
"LVrun_path_option#" &
"Satoolchain_version#" &
"Satoolchain_description#" &
+ "Saobject_generated#" &
+ "Saobjects_linked#" &
-- Configuration - Libraries
-- 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);
-- 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
-- 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
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
-- 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
-- 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
-- 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;
end if;
end if;
- if The_Project /= Empty_Node then
+ if Present (The_Project) then
-- Looking for '<same attribute name>
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.
-- 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
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",
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
-- 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",
-- 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);
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)) &
(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
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 :=
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) &
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);
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
begin
if The_Project_Name_And_Node =
- Tree_Private_Part.No_Project_Name_And_Node
+ Tree_Private_Part.No_Project_Name_And_Node
then
Error_Msg ("unknown project """ &
Get_Name_String
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
- loop
- Current := Next_String_Type (Current, In_Tree);
- end loop;
+ 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;
+
+ exit when Present (Current);
- if Current = Empty_Node then
+ Proj := Parent_Project_Of (Proj, In_Tree);
+ exit when No (Proj);
+ end loop;
+ end if;
+
+ if No (Current) then
Error_Msg ("unknown string type """ &
Get_Name_String (String_Type_Name) &
"""",
Type_Location);
OK := False;
+
else
Set_String_Type_Of
(Variable, In_Tree, To => Current);
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
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
- The_Variable := First_Variable_Of (Current_Project, In_Tree);
+ 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));
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,
end if;
end;
end if;
-
end Parse_Variable_Declaration;
end Prj.Dect;
-- --
-- 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- --
with System.Case_Util; use System.Case_Util;
with System.CRTL;
-with System.Regexp; use System.Regexp;
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);
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 --
Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd));
end Dup2;
- ----------
- -- Make --
- ----------
+ --------------
+ -- Finalize --
+ --------------
- 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;
+ procedure Finalize is
+ Discard : Boolean;
+ pragma Warnings (Off, Discard);
- Path_Name : String (1 .. File_Path'Length +
- Project_File_Extension'Length);
- Path_Last : Natural := File_Path'Length;
+ Current_Source_Dir : Project_Node_Id := Empty_Node;
- Directory_Last : Natural := 0;
+ begin
+ if Project_File then
+ -- If there were no already existing project file, or if the parsing
+ -- was unsuccessful, create an empty project node with the correct
+ -- name and its project declaration node.
- Output_Name : String (Path_Name'Range);
- Output_Name_Last : Natural;
- Output_Name_Id : Name_Id;
+ 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_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;
+ end if;
- 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;
+ end if;
- 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;
+ -- Delete the file if it already exists
- Project_Naming_File_Name : String (1 .. Output_Name'Length +
- Naming_File_Suffix'Length);
+ Delete_File
+ (Path_Name (Directory_Last + 1 .. Path_Last),
+ Success => Discard);
- Project_Naming_Last : Natural;
- Project_Naming_Id : Name_Id := No_Name;
+ -- Create a new one
- Excluded_Expressions : array (Excluded_Patterns'Range) of Regexp;
- Regular_Expressions : array (Name_Patterns'Range) of Regexp;
- Foreign_Expressions : array (Foreign_Patterns'Range) of Regexp;
+ 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;
- Source_List_Path : String (1 .. Output_Name'Length +
- Source_List_File_Suffix'Length);
- Source_List_Last : Natural;
+ Output_FD := Create_New_File
+ (Path_Name (Directory_Last + 1 .. Path_Last),
+ Fmode => Text);
- Source_List_FD : File_Descriptor;
+ -- Fails if project file cannot be created
- Args : Argument_List (1 .. Preproc_Switches'Length + 6);
+ if Output_FD = Invalid_FD then
+ Prj.Com.Fail
+ ("cannot create new """, Path_Name (1 .. Path_Last), """");
+ end if;
- type SFN_Pragma is record
- Unit : Name_Id;
- File : Name_Id;
- Index : Int := 0;
- Spec : Boolean;
- end record;
+ if Project_File then
- 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");
+ -- Delete the source list file, if it already exists
- 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;
- 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_Pragma_Index : Natural := 0;
- File_Name_Id : Name_Id := No_Name;
- SFN_Prag : SFN_Pragma;
+ if Source_List_FD = Invalid_FD then
+ Prj.Com.Fail
+ ("cannot create file """,
+ Source_List_Path (1 .. Source_List_Last),
+ """");
+ end if;
- begin
- -- Avoid processing the same directory more than once
+ 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;
- for Index in 1 .. Processed_Directories.Last loop
- if Processed_Directories.Table (Index).all = Dir_Name then
- Process := False;
- exit;
- end if;
- end loop;
+ -- Create the naming project node
- if Process then
- if Opt.Verbose_Mode then
- Output.Write_Str ("Processing directory """);
- Output.Write_Str (Dir_Name);
- Output.Write_Line ("""");
- end if;
+ 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);
- Processed_Directories. Increment_Last;
- Processed_Directories.Table (Processed_Directories.Last) :=
- new String'(Dir_Name);
+ -- 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).
- -- Get the source file names from the directory. Fails if the
- -- directory does not exist.
+ declare
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item, In_Tree => Tree);
- begin
- Open (Dir, Dir_Name);
- exception
- when Directory_Error =>
- Prj.Com.Fail ("cannot open directory """, Dir_Name, """");
- end;
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- -- Process each regular file in the directory
+ Expression : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- File_Loop : loop
- 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 Present (With_Clause) loop
+ exit when
+ Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id;
+ With_Clause := Next_With_Clause_Of (With_Clause, Tree);
+ end loop;
- for Index in Excluded_Expressions'Range loop
- if
- Match (Canon (1 .. Last), Excluded_Expressions (Index))
- then
- Matched := Excluded;
- exit;
- end if;
- end loop;
+ 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);
- -- If it does not match any of the excluded expressions,
- -- check if the file name matches at least one of the
- -- regular expressions.
+ -- We set the project node to something different than
+ -- Empty_Node, so that Prj.PP does not generate a limited
+ -- with clause.
- if Matched = True then
- Matched := False;
+ Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
- 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;
+ 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 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;
+ Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
- -- If the file name matches one of the regular expressions,
- -- parse it to get its unit name.
+ -- 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;
+ declare
+ 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;
-
- if Gcc_Path = null then
- Prj.Com.Fail ("could not locate " & Gcc);
- end if;
- 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 => Naming);
+ Set_Name_Of (Naming, Tree, To => Name_Naming);
+ Set_Project_Of_Renamed_Package_Of
+ (Naming, Tree, To => Project_Naming_Node);
- -- If we don't have yet the file name of the
- -- temporary file, get it now.
+ -- Attach the comments, if any, that were saved for package
+ -- Naming.
- if Temp_File_Name = null then
- Create_Temp_File (FD, Temp_File_Name);
+ Tree.Project_Nodes.Table (Naming).Comments :=
+ Naming_Package_Comments;
+ end;
- if FD = Invalid_FD then
- Prj.Com.Fail
- ("could not create temporary file");
- end if;
+ -- Add an attribute declaration for Source_Dirs, initialized as an
+ -- empty list.
- Close (FD);
- Delete_File (Temp_File_Name.all, Success);
- end if;
+ declare
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => Tree);
- Args (Args'Last) := new String'
- (Dir_Name &
- Directory_Separator &
- Str (1 .. Last));
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- -- Create the temporary file
+ Expression : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- FD := Create_Output_Text_File
- (Name => Temp_File_Name.all);
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term, In_Tree => Tree,
+ And_Expr_Kind => List);
- if FD = Invalid_FD then
- Prj.Com.Fail
- ("could not create temporary file");
- 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);
- -- Save the standard output and error
+ -- Attach the comments, if any, that were saved for attribute
+ -- Source_Dirs.
- Saved_Output := Dup (Standout);
- Saved_Error := Dup (Standerr);
+ Tree.Project_Nodes.Table (Attribute).Comments :=
+ Source_Dirs_Comments;
+ end;
- -- Set standard output and error to the temporary file
+ -- Put the source directories in attribute Source_Dirs
- Dup2 (FD, Standout);
- Dup2 (FD, Standerr);
+ 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);
- -- And spawn the compiler
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- Spawn (Gcc_Path.all, Args, Success);
+ Value : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Literal_String,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- -- Restore the standard output and error
+ begin
+ if No (Current_Source_Dir) then
+ Set_First_Expression_In_List
+ (Source_Dirs_List, Tree, To => Expression);
+ else
+ Set_Next_Expression_In_List
+ (Current_Source_Dir, Tree, To => Expression);
+ end if;
- Dup2 (Saved_Output, Standout);
- Dup2 (Saved_Error, Standerr);
+ 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;
- -- Close the temporary file
+ -- Add an attribute declaration for Source_Files or Source_List_File
+ -- with the source list file name that will be created.
- Close (FD);
+ declare
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => Tree);
- -- And close the saved standard output and error to
- -- avoid too many file descriptors.
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- Close (Saved_Output);
- Close (Saved_Error);
+ Expression : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- -- Now that standard output is restored, check if
- -- the compiler ran correctly.
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- -- Read the lines of the temporary file:
- -- they should contain the kind and name of the unit.
+ Value : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Literal_String,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- declare
- File : Text_File;
- Text_Line : String (1 .. 1_000);
- Text_Last : Natural;
+ 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);
- begin
- Open (File, Temp_File_Name.all);
+ Set_Name_Of (Attribute, Tree, To => Name_Source_List_File);
+ Set_Expression_Of (Attribute, Tree, To => Expression);
+ Set_First_Term (Expression, Tree, To => Term);
+ Set_Current_Term (Term, Tree, To => Value);
+ Name_Len := Source_List_Last;
+ Name_Buffer (1 .. Name_Len) :=
+ Source_List_Path (1 .. Source_List_Last);
+ Set_String_Value_Of (Value, Tree, To => Name_Find);
- if not Is_Valid (File) then
- Prj.Com.Fail
- ("could not read temporary file");
- end if;
+ -- If there was no comments for attribute Source_List_File, put
+ -- those for Source_Files, if they exist.
- Save_Last_Pragma_Index := SFN_Pragmas.Last;
+ if Present (Source_List_File_Comments) then
+ Tree.Project_Nodes.Table (Attribute).Comments :=
+ Source_List_File_Comments;
+ else
+ Tree.Project_Nodes.Table (Attribute).Comments :=
+ Source_Files_Comments;
+ end if;
+ end;
- if End_Of_File (File) then
- if Opt.Verbose_Mode then
- if not Success then
- Output.Write_Str (" (process died) ");
- end if;
- end if;
+ -- Put the sources in the source list files and in the naming
+ -- project.
- else
- Line_Loop : while not End_Of_File (File) loop
- Get_Line (File, Text_Line, Text_Last);
+ for Source_Index in 1 .. Sources.Last loop
- -- Find the first closing parenthesis
+ -- Add the corresponding attribute in the
+ -- Naming package of the naming project.
- Char_Loop : for J in 1 .. Text_Last loop
- if Text_Line (J) = ')' then
- if J >= 13 and then
- Text_Line (1 .. 4) = "Unit"
- then
- -- Add entry to SFN_Pragmas table
+ declare
+ Current_Source : constant Source :=
+ Sources.Table (Source_Index);
- 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)");
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind =>
+ N_Declarative_Item,
+ In_Tree => Tree);
- 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;
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind =>
+ N_Attribute_Declaration,
+ In_Tree => Tree);
+
+ Expression : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ And_Expr_Kind => Single,
+ In_Tree => Tree);
+
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term,
+ And_Expr_Kind => Single,
+ In_Tree => Tree);
+
+ Value : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Literal_String,
+ And_Expr_Kind => Single,
+ In_Tree => Tree);
- if Save_Last_Pragma_Index = SFN_Pragmas.Last then
- if Opt.Verbose_Mode then
- Output.Write_Line (" not a unit");
- end if;
+ begin
+ -- Add source file name to the source list file
- 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;
+ 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 Index in Save_Last_Pragma_Index + 1 ..
- SFN_Pragmas.Last
- loop
- SFN_Prag := SFN_Pragmas.Table (Index);
+ -- 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
+ (Naming_Package, Tree),
+ In_Tree => Tree);
+ Set_First_Declarative_Item_Of
+ (Naming_Package,
+ To => Decl_Item,
+ In_Tree => Tree);
+ Set_Current_Item_Node
+ (Decl_Item,
+ To => Attribute,
+ In_Tree => Tree);
+
+ -- Is it a spec or a body?
+
+ if Current_Source.Spec then
+ Set_Name_Of
+ (Attribute, Tree,
+ To => Name_Spec);
+ else
+ Set_Name_Of
+ (Attribute, Tree,
+ To => Name_Body);
+ end if;
- if Opt.Verbose_Mode then
- if SFN_Prag.Spec then
- Output.Write_Str (" spec of ");
+ -- Get the name of the unit
- else
- Output.Write_Str (" body of ");
- end if;
+ Get_Name_String (Current_Source.Unit_Name);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Set_Associative_Array_Index_Of
+ (Attribute, Tree, To => Name_Find);
- Output.Write_Line
- (Get_Name_String (SFN_Prag.Unit));
- end if;
+ Set_Expression_Of
+ (Attribute, Tree, To => Expression);
+ Set_First_Term
+ (Expression, Tree, To => Term);
+ Set_Current_Term
+ (Term, Tree, To => Value);
- if Project_File then
+ -- And set the name of the file
- -- Add the corresponding attribute in the
- -- Naming package of the naming project.
+ Set_String_Value_Of
+ (Value, Tree, To => Current_Source.File_Name);
+ Set_Source_Index_Of
+ (Value, Tree, To => Current_Source.Index);
+ end if;
+ end;
+ end loop;
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind =>
- N_Declarative_Item,
- In_Tree => Tree);
+ -- Close the source list file
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind =>
- N_Attribute_Declaration,
- In_Tree => Tree);
-
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- And_Expr_Kind => Single,
- In_Tree => Tree);
-
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- And_Expr_Kind => Single,
- In_Tree => Tree);
-
- Value : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String,
- And_Expr_Kind => Single,
- In_Tree => Tree);
-
- begin
- Set_Next_Declarative_Item
- (Decl_Item,
- To => First_Declarative_Item_Of
- (Naming_Package, Tree),
- In_Tree => Tree);
- Set_First_Declarative_Item_Of
- (Naming_Package,
- To => Decl_Item,
- In_Tree => Tree);
- Set_Current_Item_Node
- (Decl_Item,
- To => Attribute,
- In_Tree => Tree);
-
- -- Is it a spec or a body?
-
- if SFN_Prag.Spec then
- Set_Name_Of
- (Attribute, Tree,
- To => Name_Spec);
- else
- Set_Name_Of
- (Attribute, Tree,
- To => Name_Body);
- end if;
+ Close (Source_List_FD);
- -- Get the name of the unit
+ -- Output the project file
- Get_Name_String (SFN_Prag.Unit);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Set_Associative_Array_Index_Of
- (Attribute, Tree, To => Name_Find);
+ 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);
- Set_Expression_Of
- (Attribute, Tree, To => Expression);
- Set_First_Term
- (Expression, Tree, To => Term);
- Set_Current_Term
- (Term, Tree, To => Value);
+ -- Delete the naming project file if it already exists
- -- And set the name of the file
+ Delete_File
+ (Project_Naming_File_Name (1 .. Project_Naming_Last),
+ Success => Discard);
- Set_String_Value_Of
- (Value, Tree, To => File_Name_Id);
- Set_Source_Index_Of
- (Value, Tree, To => SFN_Prag.Index);
- end;
- end if;
- end loop;
+ -- Create a new one
- if Project_File then
- -- Add source file name to source list
- -- file.
+ 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;
- Last := Last + 1;
- Str (Last) := ASCII.LF;
+ Output_FD := Create_New_File
+ (Project_Naming_File_Name (1 .. Project_Naming_Last),
+ Fmode => Text);
- if Write (Source_List_FD,
- Str (1)'Address,
- Last) /= Last
- then
- Prj.Com.Fail ("disk full");
- end if;
- end if;
- end if;
+ -- Fails if naming project file cannot be created
- Close (File);
+ if Output_FD = Invalid_FD then
+ Prj.Com.Fail
+ ("cannot create new """,
+ Project_Naming_File_Name (1 .. Project_Naming_Last),
+ """");
+ end if;
- Delete_File (Temp_File_Name.all, Success);
- end;
- end;
+ -- Output the naming project file
- -- File name matches none of the regular expressions
+ Prj.PP.Pretty_Print
+ (Project_Naming_Node, Tree,
+ W_Char => Write_A_Char'Access,
+ W_Eol => Write_Eol'Access,
+ W_Str => Write_A_String'Access,
+ Backward_Compatibility => False);
+ Close (Output_FD);
- else
- -- If file is not excluded, see if this is foreign source
+ else
+ -- For each Ada source, write a pragma Source_File_Name to the
+ -- configuration pragmas file.
- 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;
- end if;
-
- if Very_Verbose then
- case Matched is
- when False =>
- Output.Write_Line ("no match");
-
- when Excluded =>
- Output.Write_Line ("excluded");
-
- when True =>
- Output.Write_Line ("foreign source");
- end case;
- end if;
-
- if Project_File and Matched = True then
-
- -- Add source file name to source list file
+ 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;
- Last := Last + 1;
- Str (Last) := ASCII.LF;
+ if Sources.Table (Index).Spec then
+ Write_A_String (" Spec_File_Name => """);
- if Write (Source_List_FD,
- Str (1)'Address,
- Last) /= Last
- then
- Prj.Com.Fail ("disk full");
- end if;
- end if;
- end if;
+ else
+ Write_A_String (" Body_File_Name => """);
end if;
- end loop File_Loop;
-
- Close (Dir);
- end if;
-
- -- If Recursively is True, call itself for each subdirectory.
- -- We do that, even when this directory has already been processed,
- -- because all of its subdirectories may not have been processed.
- if Recursively then
- Open (Dir, Dir_Name);
-
- loop
- Read (Dir, Str, Last);
- exit when Last = 0;
+ Write_A_String
+ (Get_Name_String (Sources.Table (Index).File_Name));
- -- Do not call itself for "." or ".."
+ Write_A_String ("""");
- 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);
+ if Sources.Table (Index).Index /= 0 then
+ Write_A_String (", Index =>");
+ Write_A_String (Sources.Table (Index).Index'Img);
end if;
- end loop;
- Close (Dir);
- end if;
- end Process_Directory;
+ Write_A_String (");");
+ Write_Eol;
+ end if;
+ end loop;
+
+ Close (Output_FD);
+ end if;
+ end Finalize;
- -- Start of processing for Make
+ ----------------
+ -- Initialize --
+ ----------------
+ procedure Initialize
+ (File_Path : String;
+ Project_File : Boolean;
+ Preproc_Switches : Argument_List;
+ Very_Verbose : Boolean)
+ is
begin
+ Makr.Very_Verbose := Initialize.Very_Verbose;
+ Makr.Project_File := Initialize.Project_File;
+
-- Do some needed initializations
Csets.Initialize;
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");
-- 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
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.
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,
-- 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
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));
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);
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,
-- 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;
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
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,
"""");
end;
end if;
+ end Initialize;
+
+ -------------
+ -- Process --
+ -------------
+
+ procedure Process
+ (Directories : Argument_List;
+ Name_Patterns : Regexp_List;
+ Excluded_Patterns : Regexp_List;
+ Foreign_Patterns : Regexp_List)
+ is
+ procedure Process_Directory (Dir_Name : String; Recursively : Boolean);
+ -- Look for Ada and foreign sources in a directory, according to the
+ -- patterns. When Recursively is True, after looking for sources in
+ -- Dir_Name, look also in its subdirectories, if any.
- if Project_File then
+ -----------------------
+ -- Process_Directory --
+ -----------------------
- -- Delete the source list file, if it already exists
+ procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is
+ Matched : Matched_Type := False;
+ Str : String (1 .. 2_000);
+ Canon : String (1 .. 2_000);
+ Last : Natural;
+ Dir : Dir_Type;
+ Do_Process : Boolean := True;
- declare
- Discard : Boolean;
- pragma Warnings (Off, Discard);
- begin
- Delete_File
- (Source_List_Path (1 .. Source_List_Last),
- Success => Discard);
- end;
+ Temp_File_Name : String_Access := null;
+ Save_Last_Source_Index : Natural := 0;
+ File_Name_Id : Name_Id := No_Name;
- -- And create a new source list file.
- -- Fail if file cannot be created.
+ Current_Source : Source;
- Source_List_FD := Create_New_File
- (Name => Source_List_Path (1 .. Source_List_Last),
- Fmode => Text);
+ begin
+ -- Avoid processing the same directory more than once
- if Source_List_FD = Invalid_FD then
- Prj.Com.Fail
- ("cannot create file """,
- Source_List_Path (1 .. Source_List_Last),
- """");
- end if;
- end if;
+ for Index in 1 .. Processed_Directories.Last loop
+ if Processed_Directories.Table (Index).all = Dir_Name then
+ Do_Process := False;
+ exit;
+ end if;
+ end loop;
- -- Compile the regular expressions. Fails immediately if any of
- -- the specified strings is in error.
+ if Do_Process then
+ if Opt.Verbose_Mode then
+ Output.Write_Str ("Processing directory """);
+ Output.Write_Str (Dir_Name);
+ Output.Write_Line ("""");
+ end if;
- for Index in Excluded_Expressions'Range loop
- if Very_Verbose then
- Output.Write_Str ("Excluded pattern: """);
- Output.Write_Str (Excluded_Patterns (Index).all);
- Output.Write_Line ("""");
- end if;
+ Processed_Directories. Increment_Last;
+ Processed_Directories.Table (Processed_Directories.Last) :=
+ new String'(Dir_Name);
- 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;
+ -- Get the source file names from the directory. Fails if the
+ -- directory does not exist.
- for Index in Foreign_Expressions'Range loop
- if Very_Verbose then
- Output.Write_Str ("Foreign pattern: """);
- Output.Write_Str (Foreign_Patterns (Index).all);
- Output.Write_Line ("""");
- end if;
+ begin
+ Open (Dir, Dir_Name);
+ exception
+ when Directory_Error =>
+ Prj.Com.Fail ("cannot open directory """, Dir_Name, """");
+ end;
- begin
- Foreign_Expressions (Index) :=
- Compile (Pattern => Foreign_Patterns (Index).all, Glob => True);
- exception
- when Error_In_Regexp =>
- Prj.Com.Fail
- ("invalid regular expression """,
- Foreign_Patterns (Index).all,
- """");
- end;
- end loop;
+ -- Process each regular file in the directory
- 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;
+ File_Loop : loop
+ Read (Dir, Str, Last);
+ exit File_Loop when Last = 0;
- begin
- Regular_Expressions (Index) :=
- Compile (Pattern => Name_Patterns (Index).all, Glob => True);
+ -- Copy the file name and put it in canonical case to match
+ -- against the patterns that have themselves already been put
+ -- in canonical case.
- exception
- when Error_In_Regexp =>
- Prj.Com.Fail
- ("invalid regular expression """,
- Name_Patterns (Index).all,
- """");
- end;
- end loop;
+ Canon (1 .. Last) := Str (1 .. Last);
+ Canonical_Case_File_Name (Canon (1 .. Last));
- 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 Is_Regular_File
+ (Dir_Name & Directory_Separator & Str (1 .. Last))
+ then
+ Matched := True;
- -- 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.
+ Name_Len := Last;
+ Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
+ File_Name_Id := Name_Find;
- 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));
+ -- First, check if the file name matches at least one of
+ -- the excluded expressions;
- end if;
+ for Index in Excluded_Patterns'Range loop
+ if
+ Match (Canon (1 .. Last), Excluded_Patterns (Index))
+ then
+ Matched := Excluded;
+ exit;
+ end if;
+ end loop;
- -- Create the naming project node, and add an attribute declaration
- -- for Source_Files as an empty list, to indicate there are no
- -- sources in the naming project.
+ -- If it does not match any of the excluded expressions,
+ -- check if the file name matches at least one of the
+ -- regular expressions.
- 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);
+ if Matched = True then
+ Matched := False;
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item, In_Tree => Tree);
+ 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;
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- In_Tree => Tree,
- And_Expr_Kind => List);
+ 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;
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- In_Tree => Tree,
- And_Expr_Kind => List);
+ -- If the file name matches one of the regular expressions,
+ -- parse it to get its unit name.
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- In_Tree => Tree,
- And_Expr_Kind => List);
-
- Empty_List : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String_List,
- In_Tree => Tree);
-
- begin
- Set_First_Declarative_Item_Of
- (Project_Naming_Decl, Tree, To => Decl_Item);
- Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package);
- Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
- Set_Name_Of (Attribute, Tree, To => Name_Source_Files);
- Set_Expression_Of (Attribute, Tree, To => Expression);
- Set_First_Term (Expression, Tree, To => Term);
- Set_Current_Term (Term, Tree, To => Empty_List);
- end;
+ if Matched = True then
+ declare
+ FD : File_Descriptor;
+ Success : Boolean;
+ Saved_Output : File_Descriptor;
+ Saved_Error : File_Descriptor;
- -- Add a with clause on the naming project in the main project, if
- -- there is not already one.
+ 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.
- declare
- With_Clause : Project_Node_Id :=
- First_With_Clause_Of (Project_Node, 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;
- 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);
- end loop;
+ if Gcc_Path = null then
+ Prj.Com.Fail ("could not locate " & Gcc);
+ end if;
+ end if;
- 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);
+ -- If we don't have yet the file name of the
+ -- temporary file, get it now.
- -- We set the project node to something different than
- -- Empty_Node, so that Prj.PP does not generate a limited
- -- with clause.
+ if Temp_File_Name = null then
+ Create_Temp_File (FD, Temp_File_Name);
- Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
+ if FD = Invalid_FD then
+ Prj.Com.Fail
+ ("could not create temporary file");
+ end if;
- Name_Len := Project_Naming_Last;
- 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;
+ Close (FD);
+ Delete_File (Temp_File_Name.all, Success);
+ end if;
- Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
+ Args (Args'Last) := new String'
+ (Dir_Name &
+ Directory_Separator &
+ Str (1 .. Last));
- -- Add a renaming declaration for package Naming in the main project
+ -- Create the temporary file
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item,
- In_Tree => Tree);
+ FD := Create_Output_Text_File
+ (Name => Temp_File_Name.all);
- Naming : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Package_Declaration,
- In_Tree => Tree);
+ if FD = Invalid_FD then
+ Prj.Com.Fail
+ ("could not create temporary file");
+ 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 => Naming);
- Set_Name_Of (Naming, Tree, To => Name_Naming);
- Set_Project_Of_Renamed_Package_Of
- (Naming, Tree, To => Project_Naming_Node);
+ -- Save the standard output and error
- -- Attach the comments, if any, that were saved for package
- -- Naming.
+ Saved_Output := Dup (Standout);
+ Saved_Error := Dup (Standerr);
- Tree.Project_Nodes.Table (Naming).Comments :=
- Naming_Package_Comments;
- end;
+ -- Set standard output and error to the temporary file
- -- 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.
+ Dup2 (FD, Standout);
+ Dup2 (FD, Standerr);
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item,
- In_Tree => Tree);
+ -- And spawn the compiler
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- In_Tree => Tree,
- And_Expr_Kind => List);
+ Spawn (Gcc_Path.all, Args.all, Success);
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- In_Tree => Tree,
- And_Expr_Kind => List);
+ -- Restore the standard output and error
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term, In_Tree => Tree,
- And_Expr_Kind => List);
+ Dup2 (Saved_Output, Standout);
+ Dup2 (Saved_Error, Standerr);
- 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);
+ -- Close the temporary file
- -- Attach the comments, if any, that were saved for attribute
- -- Source_Dirs.
+ Close (FD);
- Tree.Project_Nodes.Table (Attribute).Comments :=
- Source_Dirs_Comments;
- end;
+ -- And close the saved standard output and error to
+ -- avoid too many file descriptors.
- -- Add an attribute declaration for Source_List_File with the
- -- source list file name that will be created.
+ Close (Saved_Output);
+ Close (Saved_Error);
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item,
- In_Tree => Tree);
+ -- Now that standard output is restored, check if
+ -- the compiler ran correctly.
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ -- Read the lines of the temporary file:
+ -- they should contain the kind and name of the unit.
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ declare
+ File : Text_File;
+ Text_Line : String (1 .. 1_000);
+ Text_Last : Natural;
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ begin
+ Open (File, Temp_File_Name.all);
- Value : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ if not Is_Valid (File) then
+ Prj.Com.Fail
+ ("could not read temporary file");
+ 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_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);
+ Save_Last_Source_Index := Sources.Last;
- -- If there was no comments for attribute Source_List_File, put
- -- those for Source_Files, if they exist.
+ if End_Of_File (File) then
+ if Opt.Verbose_Mode then
+ if not Success then
+ Output.Write_Str (" (process died) ");
+ end if;
+ end if;
- if Source_List_File_Comments /= Empty_Node then
- 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;
+ else
+ Line_Loop : while not End_Of_File (File) loop
+ Get_Line (File, Text_Line, Text_Last);
- -- Process each directory
+ -- Find the first closing parenthesis
- for Index in Directories'Range loop
+ Char_Loop : for J in 1 .. Text_Last loop
+ if Text_Line (J) = ')' then
+ if J >= 13 and then
+ Text_Line (1 .. 4) = "Unit"
+ then
+ -- Add entry to Sources table
- declare
- Dir_Name : constant String := Directories (Index).all;
- Last : Natural := Dir_Name'Last;
- Recursively : Boolean := False;
+ 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)");
- begin
- if Dir_Name'Length >= 4
- and then (Dir_Name (Last - 2 .. Last) = "/**")
- then
- Last := Last - 3;
- Recursively := True;
- end if;
+ Sources.Append (Current_Source);
+ end if;
- if Project_File then
+ exit Char_Loop;
+ end if;
+ end loop Char_Loop;
+ end loop Line_Loop;
+ end if;
- -- Add the directory in the list for attribute Source_Dirs
+ if Save_Last_Source_Index = Sources.Last then
+ if Opt.Verbose_Mode then
+ Output.Write_Line (" not a unit");
+ end if;
- declare
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- In_Tree => Tree,
- And_Expr_Kind => Single);
-
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- In_Tree => Tree,
- And_Expr_Kind => Single);
-
- Value : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ 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;
+ end if;
- 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);
- end if;
+ for Index in Save_Last_Source_Index + 1 ..
+ Sources.Last
+ loop
+ Current_Source := Sources.Table (Index);
- 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;
- end if;
+ if Opt.Verbose_Mode then
+ if Current_Source.Spec then
+ Output.Write_Str (" spec of ");
- Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively);
- end;
+ else
+ Output.Write_Str (" body of ");
+ end if;
- end loop;
+ Output.Write_Line
+ (Get_Name_String
+ (Current_Source.Unit_Name));
+ end if;
+ end loop;
+ end if;
- if Project_File then
- Close (Source_List_FD);
- end if;
+ Close (File);
- declare
- Discard : Boolean;
- pragma Warnings (Off, Discard);
+ Delete_File (Temp_File_Name.all, Success);
+ end;
+ end;
- begin
- -- Delete the file if it already exists
+ -- File name matches none of the regular expressions
- Delete_File
- (Path_Name (Directory_Last + 1 .. Path_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_Patterns'Range loop
+ if Match (Canon (1 .. Last),
+ Foreign_Patterns (Index))
+ then
+ Matched := True;
+ exit;
+ end if;
+ end loop;
+ end if;
- if Opt.Verbose_Mode then
- Output.Write_Str ("Creating new file """);
- Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_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
- (Path_Name (Directory_Last + 1 .. Path_Last),
- Fmode => Text);
+ when Excluded =>
+ Output.Write_Line ("excluded");
- -- Fails if project file cannot be created
+ when True =>
+ Output.Write_Line ("foreign source");
+ end case;
+ end if;
- if Output_FD = Invalid_FD then
- Prj.Com.Fail
- ("cannot create new """, Path_Name (1 .. Path_Last), """");
- end if;
+ if Matched = True then
- if Project_File then
+ -- Add source file name without unit name
- -- Output the project file
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Canon (1 .. Last));
+ Sources.Append
+ ((File_Name => Name_Find,
+ Unit_Name => No_Name,
+ Index => 0,
+ Spec => False));
+ end if;
+ end if;
+ end if;
+ end loop File_Loop;
- Prj.PP.Pretty_Print
- (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);
+ Close (Dir);
+ end if;
- -- Delete the naming project file if it already exists
+ -- If Recursively is True, call itself for each subdirectory.
+ -- We do that, even when this directory has already been processed,
+ -- because all of its subdirectories may not have been processed.
- Delete_File
- (Project_Naming_File_Name (1 .. Project_Naming_Last),
- Success => Discard);
+ if Recursively then
+ Open (Dir, Dir_Name);
- -- Create a new one
+ loop
+ Read (Dir, Str, Last);
+ exit when Last = 0;
- 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;
+ -- Do not call itself for "." or ".."
- Output_FD := Create_New_File
- (Project_Naming_File_Name (1 .. Project_Naming_Last),
- Fmode => Text);
+ 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;
- -- Fails if naming project file cannot be created
+ Close (Dir);
+ end if;
+ end Process_Directory;
- if Output_FD = Invalid_FD then
- Prj.Com.Fail
- ("cannot create new """,
- Project_Naming_File_Name (1 .. Project_Naming_Last),
- """");
- end if;
+ -- Start of processing for Process
- -- Output the naming project file
+ begin
+ Processed_Directories.Set_Last (0);
- 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);
+ -- Process each directory
- else
- -- Write to the output file each entry in the SFN_Pragmas table
- -- as an pragma Source_File_Name.
+ for Index in Directories'Range loop
- 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;
+ 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).Spec then
- Write_A_String (" Spec_File_Name => """);
+ begin
+ Canonical_Case_File_Name (Canonical);
- else
- Write_A_String (" Body_File_Name => """);
+ 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;
- Write_A_String
- (Get_Name_String (SFN_Pragmas.Table (Index).File));
-
- Write_A_String ("""");
-
- if SFN_Pragmas.Table (Index).Index /= 0 then
- Write_A_String (", Index =>");
- Write_A_String (SFN_Pragmas.Table (Index).Index'Img);
- end if;
+ if not Found then
+ Source_Directories.Append (new String'(Canonical));
+ end if;
- Write_A_String (");");
- Write_Eol;
- end loop;
+ if Dir_Name'Length >= 4
+ and then (Dir_Name (Last - 2 .. Last) = "/**")
+ then
+ Last := Last - 3;
+ Recursively := True;
+ end if;
- Close (Output_FD);
- end if;
- end;
+ Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively);
+ end;
- end Make;
+ end loop;
+ end Process;
----------------
-- Write_Char --
-- --
-- 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- --
-- 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;
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);
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,
-- 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.
-- 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;
-- efficiency to avoid system calls to recompute it.
procedure Get_Path_Names_And_Record_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String);
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String);
-- Find the path names of the source files in the Source_Names table
-- in the source directories and record those that are Ada sources.
-- a specified language.
procedure Search_Directories
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- For_All_Sources : Boolean);
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ For_All_Sources : Boolean);
-- Search the source directories to find the sources.
-- If For_All_Sources is True, check each regular file name against the
-- naming schemes of the different languages. Otherwise consider only the
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.
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.
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).
-- 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.
procedure Look_For_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String);
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ 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;
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.
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;
-- ??? needs comment
procedure Report_No_Sources
- (Project : Project_Id;
- Lang_Name : String;
- In_Tree : Project_Tree_Ref;
- Location : Source_Ptr);
+ (Project : Project_Id;
+ Lang_Name : String;
+ In_Tree : Project_Tree_Ref;
+ 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.
(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;
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
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;
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);
Src_Data : Source_Data;
Alt_Lang : Alternate_Language_Id;
Alt_Lang_Data : Alternate_Language_Data;
+ Continuation : Boolean := False;
begin
Language := Data.First_Language_Processing;
(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;
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
(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;
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 --
--------------------------
"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);
+ Continuation := Continuation_String'Access;
end if;
-
- Continuation := Continuation_String'Access;
end if;
elsif Data.Library_Kind /= Static and then
if Msg (First) = '\' then
First := First + 1;
+ end if;
- -- Warning character is always the first one in this package
- -- this is an undocumented kludge???
+ -- 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: ");
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 =>
(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
-------------------------------------------
procedure Get_Path_Names_And_Record_Ada_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ 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;
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);
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;
else
Name_Loc.Found := True;
+ Source_Names.Set (File_Name, Name_Loc);
+
if Name_Loc.Source = No_Source then
Check_Name := True;
end if;
if Check_Name then
+ Other_Part := No_Source;
+
Check_Naming_Schemes
(In_Tree => In_Tree,
Data => Data,
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
- if (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)
+ 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)
then
-- Duplication of file/unit in same project is only
-- allowed if order of source directories is known.
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;
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;
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,
------------------------
procedure Search_Directories
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- For_All_Sources : Boolean)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ For_All_Sources : Boolean)
is
Source_Dir : String_List_Id;
Element : String_Element;
declare
Source_Directory : constant String :=
- Name_Buffer (1 .. Name_Len) &
- Directory_Separator;
- Dir_Last : constant Natural :=
- Compute_Directory_Last
- (Source_Directory);
+ Name_Buffer (1 .. Name_Len) &
+ Directory_Separator;
+
+ Dir_Last : constant Natural :=
+ Compute_Directory_Last
+ (Source_Directory);
begin
if Current_Verbosity = High then
-- ??? 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
declare
FF : File_Found :=
- Excluded_Sources_Htable.Get (File_Name);
+ Excluded_Sources_Htable.Get (File_Name);
begin
if FF /= No_File_Found then
when Directory_Error =>
null;
end;
+
Source_Dir := Element.Next;
end loop;
----------------------
procedure Look_For_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Current_Dir : String)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String)
is
procedure Remove_Locally_Removed_Files_From_Units;
-- Mark all locally removed sources as such in the Units table
---------------------------------------------
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;
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;
--------------------------------------------
procedure Process_Sources_In_Multi_Language_Mode is
- Source : Source_Id := Data.First_Source;
- Src_Data : Source_Data;
- Name_Loc : Name_Location;
- OK : Boolean;
- FF : File_Found;
+ 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);
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;
if Src_Data.Unit /= No_Name then
declare
Unit_Except : Unit_Exception :=
- Unit_Exceptions.Get (Src_Data.Unit);
+ Unit_Exceptions.Get (Src_Data.Unit);
begin
Unit_Except.Name := Src_Data.Unit;
(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;
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;
In_Tree : Project_Tree_Ref) return Boolean
is
Current : Project_Id := Extending;
+
begin
loop
if Current = No_Project then
declare
Canonical_Path : constant String :=
- Normalize_Pathname
- (Get_Name_String (Path_Name),
- Directory => Current_Dir,
- Resolve_Links => Opt.Follow_Links_For_Files,
- Case_Sensitive => False);
+ Normalize_Pathname
+ (Get_Name_String (Path_Name),
+ Directory => Current_Dir,
+ Resolve_Links => Opt.Follow_Links_For_Files,
+ Case_Sensitive => False);
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Canonical_Path);
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 (" """);
-- 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)) :=
- (Value => Name_Id (Canonical_File_Name),
- Display_Value => Name_Id (File_Name),
- Location => No_Location,
- Flag => False,
- Next => Nil_String,
- Index => Unit_Ind);
+ (String_Element_Table.Last (In_Tree.String_Elements)) :=
+ (Value => Name_Id (Canonical_File_Name),
+ Display_Value => Name_Id (File_Name),
+ Location => No_Location,
+ Flag => False,
+ Next => Nil_String,
+ 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
The_Unit_Data := In_Tree.Units.Table (The_Unit);
if (The_Unit_Data.File_Names (Unit_Kind).Name =
- Canonical_File_Name
- and then
- The_Unit_Data.File_Names (Unit_Kind).Path = Slash)
+ Canonical_File_Name
+ and then
+ The_Unit_Data.File_Names (Unit_Kind).Path = Slash)
or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
or else Project_Extends
(Data.Extends,
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
- The_Unit_Data.File_Names (Unit_Kind).Path =
- Canonical_Path_Name)
+ and then (Data.Known_Order_Of_Source_Dirs
+ or else
+ The_Unit_Data.File_Names (Unit_Kind).Path =
+ Canonical_Path_Name)
then
if Previous_Source = Nil_String then
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;
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;
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 %%",
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;
if Naming_Exceptions then
Write_Str ("naming exceptions");
-
else
Write_Str ("sources");
end if;
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;
-- 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);
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;
In_Tree : Project_Tree_Ref)
is
Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
-
Source : Source_Id;
begin
Write_Line (Id'Img);
end if;
- In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
+ if Replaced_By /= No_Source then
+ In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
+ In_Tree.Sources.Table (Replaced_By).Declared_In_Interfaces :=
+ In_Tree.Sources.Table (Id).Declared_In_Interfaces;
+ end if;
-- Remove the source from the global source list
-----------------------
procedure Report_No_Sources
- (Project : Project_Id;
- Lang_Name : String;
- In_Tree : Project_Tree_Ref;
- Location : Source_Ptr)
+ (Project : Project_Id;
+ Lang_Name : String;
+ In_Tree : Project_Tree_Ref;
+ Location : Source_Ptr;
+ Continuation : Boolean := False)
is
begin
case When_No_Sources is
null;
when Warning | Error =>
- Error_Msg_Warn := When_No_Sources = Warning;
- Error_Msg
- (Project, In_Tree,
- "<there are no " & Lang_Name & " sources in this project",
- Location);
+ 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, "\" & Msg, Location);
+
+ else
+ Error_Msg
+ (Project, In_Tree, Msg, Location);
+ end if;
+ end;
end case;
end Report_No_Sources;
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
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);
-- --
-- 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- --
-- 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,
E => (Name => Virtual_Name_Id,
Node => Virtual_Project,
Canonical_Path => No_Path,
- Extended => False));
+ Extended => False,
+ Proj_Qualifier => Unspecified));
end Create_Virtual_Extending_Project;
----------------------------
-- 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;
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;
-- 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
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) /=
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);
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;
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;
-- 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;
Previous_Project := Current_Project;
- if Current_Project = Empty_Node then
+ if No (Current_Project) then
-- First with clause of the context clause
-- 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,
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
Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT);
- Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
- Name_Of_Project : Name_Id := No_Name;
+ 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;
if Extended then
if A_Project_Name_And_Node.Extended then
- Error_Msg
- ("cannot extend the same project file several times",
- Token_Ptr);
+ 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",
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).
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"
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
-- 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 %%",
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;
Current_Dir => Current_Dir);
end;
- -- A project that extends an extending-all project is also
- -- an extending-all project.
+ if Present (Extended_Project) 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 Extended_Project /= Empty_Node
- and then Is_Extending_All (Extended_Project, In_Tree)
- then
- Set_Is_Extending_All (Project, In_Tree);
+ 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;
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
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;
-- 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 the parent project was not found, report an error
+ if Parent_Found then
+ Set_Parent_Project_Of (Project, In_Tree, To => Parent_Node);
+
+ else
+ -- If the parent project was not found, report an error
- if not Parent_Found then
Error_Msg_Name_1 := Name_Of_Project;
Error_Msg_Name_2 := Parent_Name;
Error_Msg ("project %% does not import or extend project %%",
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);
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;
-- 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)
- or else
- (In_Configuration and then
- Canonical (First .. Last) = Config_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)
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
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)
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),
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;
end if;
Write_String (" use ");
- Print (Expression_Of (Node, In_Tree), Indent);
+
+ if Present (Expression_Of (Node, In_Tree)) then
+ Print (Expression_Of (Node, In_Tree), Indent);
+
+ else
+ -- Full associative array declaration
+
+ if
+ Present (Associative_Project_Of (Node, In_Tree))
+ then
+ Output_Name
+ (Name_Of
+ (Associative_Project_Of (Node, In_Tree),
+ In_Tree));
+
+ if
+ Present (Associative_Package_Of (Node, In_Tree))
+ then
+ Write_String (".");
+ Output_Name
+ (Name_Of
+ (Associative_Package_Of (Node, In_Tree),
+ In_Tree));
+ end if;
+
+ elsif
+ Present (Associative_Package_Of (Node, In_Tree))
+ then
+ Output_Name
+ (Name_Of
+ (Associative_Package_Of (Node, In_Tree),
+ In_Tree));
+ end if;
+
+ Write_String ("'");
+ Output_Attribute_Name (Name_Of (Node, In_Tree));
+ end if;
+
Write_String (";");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node, In_Tree), Indent);
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;
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;
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 (".");
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;
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));
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
- or else not Eliminate_Empty_Case_Constructions
+ 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;
exit;
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);
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;
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
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;
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);
-- 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
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
Next_Expression_In_List
(String_Node, From_Project_Node_Tree);
- exit when String_Node = Empty_Node;
+ exit when No (String_Node);
Value :=
Expression
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
With_Name => The_Name);
end if;
- if Term_Package /= Empty_Node then
+ if Present (Term_Package) then
-- This is an attribute of a package
-- 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 =>
Current_Item := Empty_Node;
Current_Declarative_Item := Item;
- while Current_Declarative_Item /= Empty_Node loop
+ while Present (Current_Declarative_Item) loop
-- Get its data
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
if Pkg /= No_Package then
In_Tree.Arrays.Table (New_Array) :=
- (Name => Current_Item_Name,
- Value => No_Array_Element,
- Next =>
+ (Name => Current_Item_Name,
+ Value => No_Array_Element,
+ Next =>
In_Tree.Packages.Table (Pkg).Decl.Arrays);
In_Tree.Packages.Table (Pkg).Decl.Arrays :=
else
In_Tree.Arrays.Table (New_Array) :=
- (Name => Current_Item_Name,
- Value => No_Array_Element,
- Next =>
+ (Name => Current_Item_Name,
+ Value => No_Array_Element,
+ Next =>
In_Tree.Projects.Table (Project).Decl.Arrays);
In_Tree.Projects.Table (Project).Decl.Arrays :=
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
(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) /=
-- 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
if Pkg /= No_Package then
In_Tree.Variable_Elements.Table (The_Variable) :=
- (Next =>
+ (Next =>
In_Tree.Packages.Table
(Pkg).Decl.Variables,
- Name => Current_Item_Name,
- Value => New_Value);
+ Name => Current_Item_Name,
+ Value => New_Value);
In_Tree.Packages.Table
(Pkg).Decl.Variables := The_Variable;
else
In_Tree.Variable_Elements.Table (The_Variable) :=
- (Next =>
+ (Next =>
In_Tree.Projects.Table
(Project).Decl.Variables,
- Name => Current_Item_Name,
- Value => New_Value);
+ Name => Current_Item_Name,
+ Value => New_Value);
In_Tree.Projects.Table
(Project).Decl.Variables :=
The_Variable;
if Pkg /= No_Package then
In_Tree.Arrays.Table (The_Array) :=
- (Name => Current_Item_Name,
- Value => No_Array_Element,
- Next =>
+ (Name => Current_Item_Name,
+ Value => No_Array_Element,
+ Next =>
In_Tree.Packages.Table
(Pkg).Decl.Arrays);
else
In_Tree.Arrays.Table (The_Array) :=
- (Name => Current_Item_Name,
- Value => No_Array_Element,
- Next =>
+ (Name => Current_Item_Name,
+ Value => No_Array_Element,
+ Next =>
In_Tree.Projects.Table
(Project).Decl.Arrays);
not Case_Insensitive
(Current_Item, From_Project_Node_Tree),
Value => New_Value,
- Next => In_Tree.Arrays.Table
+ Next => In_Tree.Arrays.Table
(The_Array).Value);
In_Tree.Arrays.Table
(The_Array).Value := The_Array_Element;
-- 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
-- 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
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;
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);
-- 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)
-- 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,
With_Clause : Project_Node_Id;
begin
- if From_Project_Node = Empty_Node then
+ if No (From_Project_Node) then
Project := No_Project;
else
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;
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,
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;
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,
-- --
-- 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- --
-- 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);
(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.
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
-- 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);
-- 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;
-- 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 %",
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
-- 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;
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
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);
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
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;
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
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
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;
-- 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
-- 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 :=
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
- loop
- Current_Variable :=
- Next_Variable (Current_Variable, In_Tree);
- end loop;
+ 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));
-- 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;
-- 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
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.
-- 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);
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
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Comments => Empty_Node);
-- If this is the first comment, put it in the right field of
-- the node Zone.
- if Previous = Empty_Node then
+ if No (Previous) then
case Where is
when Before =>
In_Tree.Project_Nodes.Table (Zone).Field1 :=
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
return In_Tree.Project_Nodes.Table (Node).Field2;
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
return In_Tree.Project_Nodes.Table (Node).Field1;
Zone : Project_Node_Id;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
-- If there is not already an N_Comment_Zones associated, create a new
-- one and associate it with node Node.
- if Zone = Empty_Node then
+ if No (Zone) then
Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table (Zone) :=
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
return In_Tree.Project_Nodes.Table (Node).Field1;
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
+ Field4 => Empty_Node,
Comments => Empty_Node);
-- Link it to the N_Comment_Zones node, if it is the first,
-- otherwise to the previous one.
- if Previous = Empty_Node then
+ if No (Previous) then
In_Tree.Project_Nodes.Table (Zone).Field1 :=
Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Directory;
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return No_Name;
else
return In_Tree.Project_Nodes.Table (Zone).Value;
In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
Zone : Project_Node_Id := Empty_Node;
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
Zone := In_Tree.Project_Nodes.Table (Node).Comments;
- if Zone = Empty_Node then
+ if No (Zone) then
return Empty_Node;
else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Packages;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field1;
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Flag1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Flag2;
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
In_Tree : Project_Node_Tree_Ref) return Boolean is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
return In_Tree.Project_Nodes.Table (Node).Flag1;
begin
-- First check all the imported projects
- while With_Clause /= Empty_Node loop
+ while Present (With_Clause) loop
-- Only non limited imported project may be used as prefix
-- of variable or attributes.
Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
- exit when Result /= Empty_Node
+ exit when Present (Result)
and then Name_Of (Result, In_Tree) = With_Name;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;
-- If it is not an imported project, it might be 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;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Kind;
end Kind_Of;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Location;
end Location_Of;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
return In_Tree.Project_Nodes.Table (Node).Name;
end Name_Of;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
return In_Tree.Project_Nodes.Table (Node).Field3;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
return In_Tree.Project_Nodes.Table (Node).Comments;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
return In_Tree.Project_Nodes.Table (Node).Field1;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
return In_Tree.Project_Nodes.Table (Node).Field2;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Typed_Variable_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
return In_Tree.Project_Nodes.Table (Node).Field2;
end Next_With_Clause_Of;
+ --------
+ -- No --
+ --------
+
+ function No (Node : Project_Node_Id) return Boolean is
+ begin
+ return Node = Empty_Node;
+ end No;
+
---------------------------------
-- Non_Limited_Project_Node_Of --
---------------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
return In_Tree.Project_Nodes.Table (Node).Field3;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
return In_Tree.Project_Nodes.Table (Node).Path_Name;
end Path_Name_Of;
+ -------------
+ -- Present --
+ -------------
+
+ function Present (Node : Project_Node_Id) return Boolean is
+ begin
+ return Node /= Empty_Node;
+ end Present;
+
----------------------------
-- Project_Declaration_Of --
----------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Field2;
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 --
-------------------------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
return In_Tree.Project_Nodes.Table (Node).Field1;
-- an end of line node specified, associate the comment with
-- this node.
- elsif End_Of_Line_Node /= Empty_Node then
+ elsif Present (End_Of_Line_Node) then
declare
Zones : constant Project_Node_Id :=
Comment_Zones_Of (End_Of_Line_Node, In_Tree);
if Comments.Last > 0 and then
not Comments.Table (1).Follows_Empty_Line then
- if Previous_Line_Node /= Empty_Node then
+ if Present (Previous_Line_Node) then
Add_Comments
(To => Previous_Line_Node,
Where => After,
In_Tree => In_Tree);
- elsif Previous_End_Node /= Empty_Node then
+ elsif Present (Previous_End_Node) then
Add_Comments
(To => Previous_End_Node,
Where => After_End,
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration));
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Directory := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Attribute_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
In_Tree.Project_Nodes.Table (Node).Comments := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Packages := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
In_Tree.Project_Nodes.Table (Node).Flag1 := True;
To : Project_Node_Kind)
is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Kind := To;
end Set_Kind_Of;
To : Source_Ptr)
is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Location := To;
end Set_Location_Of;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
To : Name_Id)
is
begin
- pragma Assert (Node /= Empty_Node);
+ pragma Assert (Present (Node));
In_Tree.Project_Nodes.Table (Node).Name := To;
end Set_Name_Of;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Field3 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind =
N_String_Type_Declaration);
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Typed_Variable_Declaration
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Project
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Field2 := To;
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 --
-----------------------------------------------
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
In_Tree.Project_Nodes.Table (Node).Field1 := To;
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Variable_Reference
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
or else
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind =
N_Variable_Reference
is
begin
pragma Assert
- (Node /= Empty_Node
+ (Present (Node)
and then
(In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
or else
is
begin
pragma Assert
- (For_Typed_Variable /= Empty_Node
+ (Present (For_Typed_Variable)
and then
(In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
N_Typed_Variable_Declaration));
In_Tree);
begin
- while Current_String /= Empty_Node
+ while Present (Current_String)
and then
String_Value_Of (Current_String, In_Tree) /= Value
loop
Next_Literal_String (Current_String, In_Tree);
end loop;
- return Current_String /= Empty_Node;
+ return Present (Current_String);
end;
end Value_Is_Valid;
-- 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.
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
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;
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
-- -- 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,
-- -- 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,
-- -- Field1: first declarative item
-- -- Field2: extended project
-- -- Field3: extending project
+ -- -- Field4: not used
-- -- Value: not used
-- N_Declarative_Item,
-- -- Field1: current item node
-- -- Field2: next declarative item
-- -- Field3: not used
+ -- -- Field4: not used
-- -- Value: not used
-- N_Package_Declaration,
-- -- 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,
-- -- Field1: first literal string
-- -- Field2: next string type
-- -- Field3: not used
+ -- -- Field4: not used
-- -- Value: not used
-- N_Literal_String,
-- -- Field1: next literal string
-- -- Field2: not used
-- -- Field3: not used
+ -- -- Field4: not used
-- -- Value: string value
-- N_Attribute_Declaration,
-- -- 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)
-- -- Field1: expression
-- -- Field2: type of variable (N_String_Type_Declaration)
-- -- Field3: next variable
+ -- -- Field4: not used
-- -- Value: not used
-- N_Variable_Declaration,
-- -- N_Variable_Declaration and
-- -- N_Typed_Variable_Declaration
-- -- Field3: next variable
+ -- -- Field4: not used
-- -- Value: not used
-- N_Expression,
-- -- Field1: current term
-- -- Field2: next term in the expression
-- -- Field3: not used
+ -- -- Field4: not used
-- -- Value: not used
-- N_Literal_String_List,
-- -- Field1: first expression
-- -- Field2: not used
-- -- Field3: not used
+ -- -- Field4: not used
-- -- Value: not used
-- N_Variable_Reference,
-- -- 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,
-- -- Field1: project
-- -- Field2: package (if attribute of a package)
-- -- Field3: not used
+ -- -- Field4: not used
-- -- Value: associative array index
-- -- (if an associative array element)
-- -- Field1: case variable reference
-- -- Field2: first case item
-- -- Field3: not used
+ -- -- Field4: not used
-- -- Value: not used
-- N_Case_Item
-- -- for when others
-- -- Field2: first declarative item
-- -- Field3: next case item
+ -- -- Field4: not used
-- -- Value: not used
-- N_Comment_zones
-- -- 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
-- -- 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
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,
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,
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 --
-----------
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.
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.
-- 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
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,
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.
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
end record;
No_Source_Data : constant Source_Data :=
- (Project => No_Project,
- Language_Name => No_Name,
- Language => No_Language_Index,
- Lang_Kind => File_Based,
- Compiled => True,
- Alternate_Languages => No_Alternate_Language,
- Kind => Spec,
- Dependency => None,
- Other_Part => No_Source,
- Unit => No_Name,
- Index => 0,
- Locally_Removed => False,
- Get_Object => False,
- Replaced_By => No_Source,
- File => No_File,
- Display_File => No_File,
- Path => No_Path,
- Display_Path => No_Path,
- Source_TS => Empty_Time_Stamp,
- Object_Project => No_Project,
- Object_Exists => True,
- Object => No_File,
- Current_Object_Path => No_Path,
- Object_Path => No_Path,
- Object_TS => Empty_Time_Stamp,
- Dep_Name => No_File,
- Current_Dep_Path => No_Path,
- Dep_Path => No_Path,
- Dep_TS => Empty_Time_Stamp,
- Switches => No_File,
- Switches_Path => No_Path,
- Switches_TS => Empty_Time_Stamp,
- Naming_Exception => False,
- Next_In_Sources => No_Source,
- Next_In_Project => No_Source,
- Next_In_Lang => No_Source);
+ (Project => No_Project,
+ Language_Name => No_Name,
+ 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,
+ Other_Part => No_Source,
+ Unit => No_Name,
+ Index => 0,
+ Locally_Removed => False,
+ Get_Object => False,
+ Replaced_By => No_Source,
+ File => No_File,
+ Display_File => No_File,
+ Path => No_Path,
+ Display_Path => No_Path,
+ 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,
+ Object_TS => Empty_Time_Stamp,
+ Dep_Name => No_File,
+ Current_Dep_Path => No_Path,
+ Dep_Path => No_Path,
+ Dep_TS => Empty_Time_Stamp,
+ Switches => No_File,
+ Switches_Path => No_Path,
+ Switches_TS => Empty_Time_Stamp,
+ Naming_Exception => False,
+ Next_In_Sources => No_Source,
+ Next_In_Project => No_Source,
+ Next_In_Lang => No_Source);
package Source_Data_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Source_Data,
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.
-- 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
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
"mapping_body_suffix#" &
"metrics#" &
"naming#" &
+ "object_generated#" &
+ "objects_linked#" &
"objects_path#" &
"objects_path_file#" &
"object_dir#" &
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 --
projects / gcc.git / commitdiff