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