diff options
| -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 -- |