diff options
Diffstat (limited to 'gcc/ada/prj-proc.adb')
| -rw-r--r-- | gcc/ada/prj-proc.adb | 1259 |
1 files changed, 793 insertions, 466 deletions
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 7adcd08..c67f2a3 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005 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- -- @@ -57,49 +57,59 @@ package body Prj.Proc is procedure Add_Attributes (Project : Project_Id; + In_Tree : Project_Tree_Ref; Decl : in out Declarations; First : Attribute_Node_Id); -- Add all attributes, starting with First, with their default -- values to the package or project with declarations Decl. procedure Check - (Project : in out Project_Id; + (In_Tree : Project_Tree_Ref; + Project : in out Project_Id; Follow_Links : Boolean); -- Set all projects to not checked, then call Recursive_Check for the -- main project Project. Project is set to No_Project if errors occurred. function Expression - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - First_Term : Project_Node_Id; - Kind : Variable_Kind) return Variable_Value; + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + First_Term : Project_Node_Id; + Kind : Variable_Kind) return Variable_Value; -- From N_Expression project node From_Project_Node, compute the value -- of an expression and return it as a Variable_Value. function Imported_Or_Extended_Project_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Project_Id; -- Find an imported or extended project of Project whose name is With_Name function Package_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Package_Id; -- Find the package of Project whose name is With_Name procedure Process_Declarative_Items - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - Item : Project_Node_Id); + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + Item : Project_Node_Id); -- Process declarative items starting with From_Project_Node, and put them -- in declarations Decl. This is a recursive procedure; it calls itself for -- a package declaration or a case construction. procedure Recursive_Process - (Project : out Project_Id; - From_Project_Node : Project_Node_Id; - Extended_By : Project_Id); + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Extended_By : Project_Id); -- Process project with node From_Project_Node in the tree. -- Do nothing if From_Project_Node is Empty_Node. -- If project has already been processed, simply return its project id. @@ -109,6 +119,7 @@ package body Prj.Proc is procedure Recursive_Check (Project : Project_Id; + In_Tree : Project_Tree_Ref; Follow_Links : Boolean); -- If Project is not marked as checked, mark it as checked, call -- Check_Naming_Scheme for the project, then call itself for a @@ -146,6 +157,7 @@ package body Prj.Proc is procedure Add_Attributes (Project : Project_Id; + In_Tree : Project_Tree_Ref; Decl : in out Declarations; First : Attribute_Node_Id) is @@ -190,12 +202,16 @@ package body Prj.Proc is end case; - Variable_Elements.Increment_Last; - Variable_Elements.Table (Variable_Elements.Last) := + Variable_Element_Table.Increment_Last + (In_Tree.Variable_Elements); + In_Tree.Variable_Elements.Table + (Variable_Element_Table.Last + (In_Tree.Variable_Elements)) := (Next => Decl.Attributes, Name => Attribute_Name_Of (The_Attribute), Value => New_Attribute); - Decl.Attributes := Variable_Elements.Last; + Decl.Attributes := Variable_Element_Table.Last + (In_Tree.Variable_Elements); end; end if; @@ -208,17 +224,20 @@ package body Prj.Proc is ----------- procedure Check - (Project : in out Project_Id; + (In_Tree : Project_Tree_Ref; + Project : in out Project_Id; Follow_Links : Boolean) is begin -- Make sure that all projects are marked as not checked - for Index in 1 .. Projects.Last loop - Projects.Table (Index).Checked := False; + for Index in Project_Table.First .. + Project_Table.Last (In_Tree.Projects) + loop + In_Tree.Projects.Table (Index).Checked := False; end loop; - Recursive_Check (Project, Follow_Links); + Recursive_Check (Project, In_Tree, Follow_Links); end Check; ---------------- @@ -226,11 +245,13 @@ package body Prj.Proc is ---------------- function Expression - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - First_Term : Project_Node_Id; - Kind : Variable_Kind) return Variable_Value + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + First_Term : Project_Node_Id; + Kind : Variable_Kind) return Variable_Value is The_Term : Project_Node_Id := First_Term; -- The term in the expression list @@ -246,14 +267,14 @@ package body Prj.Proc is begin Result.Project := Project; - Result.Location := Location_Of (First_Term); + Result.Location := Location_Of (First_Term, From_Project_Node_Tree); -- Process each term of the expression, starting with First_Term while The_Term /= Empty_Node loop - The_Current_Term := Current_Term (The_Term); + The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree); - case Kind_Of (The_Current_Term) is + case Kind_Of (The_Current_Term, From_Project_Node_Tree) is when N_Literal_String => @@ -267,30 +288,46 @@ package body Prj.Proc is raise Program_Error; when Single => - Add (Result.Value, String_Value_Of (The_Current_Term)); - Result.Index := Source_Index_Of (The_Current_Term); + Add (Result.Value, + String_Value_Of + (The_Current_Term, From_Project_Node_Tree)); + Result.Index := + Source_Index_Of + (The_Current_Term, From_Project_Node_Tree); when List => - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then -- This can happen in an expression like () & "toto" - Result.Values := String_Elements.Last; + Result.Values := String_Element_Table.Last + (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := String_Element_Table.Last + (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := - (Value => String_Value_Of (The_Current_Term), - Index => Source_Index_Of (The_Current_Term), + Last := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Last) := + (Value => + String_Value_Of + (The_Current_Term, + From_Project_Node_Tree), + Index => + Source_Index_Of + (The_Current_Term, From_Project_Node_Tree), Display_Value => No_Name, - Location => Location_Of (The_Current_Term), + Location => + Location_Of + (The_Current_Term, + From_Project_Node_Tree), Flag => False, Next => Nil_String); end case; @@ -299,7 +336,9 @@ package body Prj.Proc is declare String_Node : Project_Node_Id := - First_Expression_In_List (The_Current_Term); + First_Expression_In_List + (The_Current_Term, + From_Project_Node_Tree); Value : Variable_Value; @@ -310,27 +349,36 @@ package body Prj.Proc is -- there is nothing to do Value := Expression - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - First_Term => Tree.First_Term (String_Node), - Kind => Single); - String_Elements.Increment_Last; + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + First_Term => + Tree.First_Term + (String_Node, From_Project_Node_Tree), + Kind => Single); + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Result.Values = Nil_String then -- This literal string list is the first term -- in a string list expression - Result.Values := String_Elements.Last; + Result.Values := + String_Element_Table.Last (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := + String_Element_Table.Last (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := + Last := + String_Element_Table.Last (In_Tree.String_Elements); + + In_Tree.String_Elements.Table (Last) := (Value => Value.Value, Display_Value => No_Name, Location => Value.Location, @@ -343,23 +391,31 @@ package body Prj.Proc is -- one after the other String_Node := - Next_Expression_In_List (String_Node); + Next_Expression_In_List + (String_Node, From_Project_Node_Tree); exit when String_Node = Empty_Node; Value := Expression - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - First_Term => Tree.First_Term (String_Node), - Kind => Single); - - String_Elements.Increment_Last; - String_Elements.Table (Last).Next := - String_Elements.Last; - Last := String_Elements.Last; - String_Elements.Table (Last) := + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + First_Term => + Tree.First_Term + (String_Node, From_Project_Node_Tree), + Kind => Single); + + String_Element_Table.Increment_Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table + (Last).Next := String_Element_Table.Last + (In_Tree.String_Elements); + Last := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Last) := (Value => Value.Value, Display_Value => No_Name, Location => Value.Location, @@ -367,9 +423,7 @@ package body Prj.Proc is Next => Nil_String, Index => Value.Index); end loop; - end if; - end; when N_Variable_Reference | N_Attribute_Reference => @@ -381,9 +435,11 @@ package body Prj.Proc is The_Variable_Id : Variable_Id := No_Variable; The_Variable : Variable_Value; Term_Project : constant Project_Node_Id := - Project_Node_Of (The_Current_Term); + Project_Node_Of + (The_Current_Term, From_Project_Node_Tree); Term_Package : constant Project_Node_Id := - Package_Node_Of (The_Current_Term); + Package_Node_Of + (The_Current_Term, From_Project_Node_Tree); Index : Name_Id := No_Name; begin @@ -392,9 +448,11 @@ package body Prj.Proc is then -- This variable or attribute comes from another project - The_Name := Name_Of (Term_Project); + The_Name := + Name_Of (Term_Project, From_Project_Node_Tree); The_Project := Imported_Or_Extended_Project_From (Project => Project, + In_Tree => In_Tree, With_Name => The_Name); end if; @@ -402,27 +460,39 @@ package body Prj.Proc is -- This is an attribute of a package - The_Name := Name_Of (Term_Package); - The_Package := Projects.Table (The_Project).Decl.Packages; + The_Name := + Name_Of (Term_Package, From_Project_Node_Tree); + The_Package := In_Tree.Projects.Table + (The_Project).Decl.Packages; while The_Package /= No_Package - and then Packages.Table (The_Package).Name /= The_Name + and then In_Tree.Packages.Table + (The_Package).Name /= The_Name loop - The_Package := Packages.Table (The_Package).Next; + The_Package := + In_Tree.Packages.Table + (The_Package).Next; end loop; pragma Assert (The_Package /= No_Package, "package not found."); - elsif Kind_Of (The_Current_Term) = N_Attribute_Reference then + elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Attribute_Reference + then The_Package := No_Package; end if; - The_Name := Name_Of (The_Current_Term); + The_Name := + Name_Of (The_Current_Term, From_Project_Node_Tree); - if Kind_Of (The_Current_Term) = N_Attribute_Reference then - Index := Associative_Array_Index_Of (The_Current_Term); + if Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Attribute_Reference + then + Index := + Associative_Array_Index_Of + (The_Current_Term, From_Project_Node_Tree); end if; -- If it is not an associative array attribute @@ -435,24 +505,26 @@ package body Prj.Proc is -- First, if there is a package, look into the package - if - Kind_Of (The_Current_Term) = N_Variable_Reference + if Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Variable_Reference then The_Variable_Id := - Packages.Table (The_Package).Decl.Variables; - + In_Tree.Packages.Table + (The_Package).Decl.Variables; else The_Variable_Id := - Packages.Table (The_Package).Decl.Attributes; + In_Tree.Packages.Table + (The_Package).Decl.Attributes; end if; while The_Variable_Id /= No_Variable and then - Variable_Elements.Table (The_Variable_Id).Name /= - The_Name + In_Tree.Variable_Elements.Table + (The_Variable_Id).Name /= The_Name loop The_Variable_Id := - Variable_Elements.Table (The_Variable_Id).Next; + In_Tree.Variable_Elements.Table + (The_Variable_Id).Next; end loop; end if; @@ -461,24 +533,26 @@ package body Prj.Proc is -- If we have not found it, look into the project - if - Kind_Of (The_Current_Term) = N_Variable_Reference + if Kind_Of (The_Current_Term, From_Project_Node_Tree) = + N_Variable_Reference then The_Variable_Id := - Projects.Table (The_Project).Decl.Variables; - + In_Tree.Projects.Table + (The_Project).Decl.Variables; else The_Variable_Id := - Projects.Table (The_Project).Decl.Attributes; + In_Tree.Projects.Table + (The_Project).Decl.Attributes; end if; while The_Variable_Id /= No_Variable and then - Variable_Elements.Table (The_Variable_Id).Name /= - The_Name + In_Tree.Variable_Elements.Table + (The_Variable_Id).Name /= The_Name loop The_Variable_Id := - Variable_Elements.Table (The_Variable_Id).Next; + In_Tree.Variable_Elements.Table + (The_Variable_Id).Next; end loop; end if; @@ -486,7 +560,8 @@ package body Prj.Proc is pragma Assert (The_Variable_Id /= No_Variable, "variable or attribute not found"); - The_Variable := Variable_Elements.Table + The_Variable := + In_Tree.Variable_Elements.Table (The_Variable_Id).Value; else @@ -497,50 +572,61 @@ package body Prj.Proc is The_Array : Array_Id := No_Array; The_Element : Array_Element_Id := No_Array_Element; Array_Index : Name_Id := No_Name; + begin if The_Package /= No_Package then The_Array := - Packages.Table (The_Package).Decl.Arrays; - + In_Tree.Packages.Table + (The_Package).Decl.Arrays; else The_Array := - Projects.Table (The_Project).Decl.Arrays; + In_Tree.Projects.Table + (The_Project).Decl.Arrays; end if; while The_Array /= No_Array - and then Arrays.Table (The_Array).Name /= The_Name + and then In_Tree.Arrays.Table + (The_Array).Name /= The_Name loop - The_Array := Arrays.Table (The_Array).Next; + The_Array := In_Tree.Arrays.Table + (The_Array).Next; end loop; if The_Array /= No_Array then - The_Element := Arrays.Table (The_Array).Value; + The_Element := In_Tree.Arrays.Table + (The_Array).Value; Get_Name_String (Index); - if Case_Insensitive (The_Current_Term) then + if Case_Insensitive + (The_Current_Term, From_Project_Node_Tree) + then To_Lower (Name_Buffer (1 .. Name_Len)); end if; Array_Index := Name_Find; while The_Element /= No_Array_Element - and then Array_Elements.Table (The_Element).Index - /= Array_Index + and then + In_Tree.Array_Elements.Table + (The_Element).Index /= Array_Index loop The_Element := - Array_Elements.Table (The_Element).Next; + In_Tree.Array_Elements.Table + (The_Element).Next; end loop; end if; if The_Element /= No_Array_Element then The_Variable := - Array_Elements.Table (The_Element).Value; + In_Tree.Array_Elements.Table + (The_Element).Value; else - if - Expression_Kind_Of (The_Current_Term) = List + if Expression_Kind_Of + (The_Current_Term, From_Project_Node_Tree) = + List then The_Variable := (Project => Project, @@ -548,7 +634,6 @@ package body Prj.Proc is Location => No_Location, Default => True, Values => Nil_String); - else The_Variable := (Project => Project, @@ -599,28 +684,38 @@ package body Prj.Proc is null; when Single => - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then -- This can happen in an expression such as -- () & Var - Result.Values := String_Elements.Last; + Result.Values := + String_Element_Table.Last + (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := + String_Element_Table.Last + (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := - (Value => The_Variable.Value, + Last := + String_Element_Table.Last + (In_Tree.String_Elements); + + In_Tree.String_Elements.Table (Last) := + (Value => The_Variable.Value, Display_Value => No_Name, - Location => Location_Of (The_Current_Term), - Flag => False, - Next => Nil_String, - Index => 0); + Location => Location_Of + (The_Current_Term, + From_Project_Node_Tree), + Flag => False, + Next => Nil_String, + Index => 0); when List => @@ -630,30 +725,44 @@ package body Prj.Proc is begin while The_List /= Nil_String loop - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then - Result.Values := String_Elements.Last; + Result.Values := + String_Element_Table.Last + (In_Tree. + String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree. + String_Elements.Table (Last).Next := + String_Element_Table.Last + (In_Tree. + String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := - (Value => - String_Elements.Table - (The_List).Value, + Last := + String_Element_Table.Last + (In_Tree.String_Elements); + + In_Tree.String_Elements.Table (Last) := + (Value => + In_Tree.String_Elements.Table + (The_List).Value, Display_Value => No_Name, - Location => Location_Of - (The_Current_Term), - Flag => False, - Next => Nil_String, - Index => 0); + Location => + Location_Of + (The_Current_Term, + From_Project_Node_Tree), + Flag => False, + Next => Nil_String, + Index => 0); + The_List := - String_Elements.Table (The_List).Next; + In_Tree. String_Elements.Table + (The_List).Next; end loop; end; end case; @@ -662,7 +771,10 @@ package body Prj.Proc is when N_External_Value => Get_Name_String - (String_Value_Of (External_Reference_Of (The_Current_Term))); + (String_Value_Of + (External_Reference_Of + (The_Current_Term, From_Project_Node_Tree), + From_Project_Node_Tree)); declare Name : constant Name_Id := Name_Find; @@ -670,11 +782,13 @@ package body Prj.Proc is Value : Name_Id := No_Name; Default_Node : constant Project_Node_Id := - External_Default_Of (The_Current_Term); + External_Default_Of + (The_Current_Term, From_Project_Node_Tree); begin if Default_Node /= Empty_Node then - Default := String_Value_Of (Default_Node); + Default := + String_Value_Of (Default_Node, From_Project_Node_Tree); end if; Value := Prj.Ext.Value_Of (Name, Default); @@ -684,18 +798,17 @@ package body Prj.Proc is if Error_Report = null then Error_Msg ("?undefined external reference", - Location_Of (The_Current_Term)); - + Location_Of + (The_Current_Term, From_Project_Node_Tree)); else Error_Report ("warning: """ & Get_Name_String (Name) & """ is an undefined external reference", - Project); + Project, In_Tree); end if; end if; Value := Empty_String; - end if; case Kind is @@ -707,21 +820,27 @@ package body Prj.Proc is Add (Result.Value, Value); when List => - String_Elements.Increment_Last; + String_Element_Table.Increment_Last + (In_Tree.String_Elements); if Last = Nil_String then - Result.Values := String_Elements.Last; + Result.Values := String_Element_Table.Last + (In_Tree.String_Elements); else - String_Elements.Table (Last).Next := - String_Elements.Last; + In_Tree.String_Elements.Table + (Last).Next := String_Element_Table.Last + (In_Tree.String_Elements); end if; - Last := String_Elements.Last; - String_Elements.Table (Last) := + Last := String_Element_Table.Last + (In_Tree.String_Elements); + In_Tree.String_Elements.Table (Last) := (Value => Value, Display_Value => No_Name, - Location => Location_Of (The_Current_Term), + Location => + Location_Of + (The_Current_Term, From_Project_Node_Tree), Flag => False, Next => Nil_String, Index => 0); @@ -740,7 +859,7 @@ package body Prj.Proc is end case; - The_Term := Next_Term (The_Term); + The_Term := Next_Term (The_Term, From_Project_Node_Tree); end loop; return Result; @@ -752,9 +871,11 @@ package body Prj.Proc is function Imported_Or_Extended_Project_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Project_Id is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); List : Project_List := Data.Imported_Projects; Result : Project_Id := No_Project; Temp_Result : Project_Id := No_Project; @@ -763,7 +884,8 @@ package body Prj.Proc is -- First check if it is the name of an extended project if Data.Extends /= No_Project - and then Projects.Table (Data.Extends).Name = With_Name + and then In_Tree.Projects.Table (Data.Extends).Name = + With_Name then return Data.Extends; @@ -771,11 +893,13 @@ package body Prj.Proc is -- Then check the name of each imported project while List /= Empty_Project_List loop - Result := Project_Lists.Table (List).Project; + Result := In_Tree.Project_Lists.Table (List).Project; -- If the project is directly imported, then returns its ID - if Projects.Table (Result).Name = With_Name then + if + In_Tree.Projects.Table (Result).Name = With_Name + then return Result; end if; @@ -784,19 +908,22 @@ package body Prj.Proc is -- returned ID if the project is not imported directly. declare - Proj : Project_Id := Projects.Table (Result).Extends; + Proj : Project_Id := + In_Tree.Projects.Table (Result).Extends; begin while Proj /= No_Project loop - if Projects.Table (Proj).Name = With_Name then + if In_Tree.Projects.Table (Proj).Name = + With_Name + then Temp_Result := Result; exit; end if; - Proj := Projects.Table (Proj).Extends; + Proj := In_Tree.Projects.Table (Proj).Extends; end loop; end; - List := Project_Lists.Table (List).Next; + List := In_Tree.Project_Lists.Table (List).Next; end loop; pragma Assert @@ -813,23 +940,26 @@ package body Prj.Proc is function Package_From (Project : Project_Id; + In_Tree : Project_Tree_Ref; With_Name : Name_Id) return Package_Id is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := + In_Tree.Projects.Table (Project); Result : Package_Id := Data.Decl.Packages; begin -- Check the name of each existing package of Project while Result /= No_Package - and then - Packages.Table (Result).Name /= With_Name + and then In_Tree.Packages.Table (Result).Name /= With_Name loop - Result := Packages.Table (Result).Next; + Result := In_Tree.Packages.Table (Result).Next; end loop; if Result = No_Package then + -- Should never happen + Write_Line ("package """ & Get_Name_String (With_Name) & """ not found"); raise Program_Error; @@ -844,11 +974,13 @@ package body Prj.Proc is ------------- procedure Process - (Project : out Project_Id; - Success : out Boolean; - From_Project_Node : Project_Node_Id; - Report_Error : Put_Line_Access; - Follow_Links : Boolean := True) + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; + Success : out Boolean; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Report_Error : Put_Line_Access; + Follow_Links : Boolean := True) is Obj_Dir : Name_Id; Extending : Project_Id; @@ -860,19 +992,21 @@ package body Prj.Proc is -- Make sure there is no projects in the data structure - Projects.Set_Last (No_Project); + Project_Table.Set_Last (In_Tree.Projects, No_Project); Processed_Projects.Reset; -- And process the main project and all of the projects it depends on, -- recursively Recursive_Process - (Project => Project, - From_Project_Node => From_Project_Node, - Extended_By => No_Project); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Extended_By => No_Project); if Project /= No_Project then - Check (Project, Follow_Links); + Check (In_Tree, Project, Follow_Links); end if; -- If main project is an extending all project, set the object @@ -880,15 +1014,18 @@ package body Prj.Proc is -- of the main project. if Project /= No_Project - and then Is_Extending_All (From_Project_Node) + and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree) then declare Object_Dir : constant Name_Id := - Projects.Table (Project).Object_Directory; + In_Tree.Projects.Table (Project).Object_Directory; begin - for Index in Projects.First .. Projects.Last loop - if Projects.Table (Index).Virtual then - Projects.Table (Index).Object_Directory := Object_Dir; + for Index in + Project_Table.First .. Project_Table.Last (In_Tree.Projects) + loop + if In_Tree.Projects.Table (Index).Virtual then + In_Tree.Projects.Table (Index).Object_Directory := + Object_Dir; end if; end loop; end; @@ -898,11 +1035,13 @@ package body Prj.Proc is -- the project(s) it extends. if Project /= No_Project then - for Proj in 1 .. Projects.Last loop - Extending := Projects.Table (Proj).Extended_By; + for Proj in + Project_Table.First .. Project_Table.Last (In_Tree.Projects) + loop + Extending := In_Tree.Projects.Table (Proj).Extended_By; if Extending /= No_Project then - Obj_Dir := Projects.Table (Proj).Object_Directory; + Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory; -- Check that a project being extended does not share its -- object directory with any project that extends it, directly @@ -911,53 +1050,42 @@ package body Prj.Proc is -- Start with the project directly extending it Extending2 := Extending; - while Extending2 /= No_Project loop - --- why is this code commented out ??? - --- if ((Process_Languages = Ada_Language --- and then --- Projects.Table (Extending2).Ada_Sources_Present) --- or else --- (Process_Languages = Other_Languages --- and then --- Projects.Table (Extending2).Other_Sources_Present)) - - if Projects.Table (Extending2).Ada_Sources_Present + if In_Tree.Projects.Table (Extending2).Ada_Sources_Present and then - Projects.Table (Extending2).Object_Directory = Obj_Dir + In_Tree.Projects.Table (Extending2).Object_Directory = + Obj_Dir then - if Projects.Table (Extending2).Virtual then - Error_Msg_Name_1 := Projects.Table (Proj).Name; + if In_Tree.Projects.Table (Extending2).Virtual then + Error_Msg_Name_1 := In_Tree.Projects.Table (Proj).Name; if Error_Report = null then Error_Msg ("project % cannot be extended by a virtual " & "project with the same object directory", - Projects.Table (Proj).Location); - + In_Tree.Projects.Table (Proj).Location); else Error_Report ("project """ & Get_Name_String (Error_Msg_Name_1) & """ cannot be extended by a virtual " & "project with the same object directory", - Project); + Project, In_Tree); end if; else Error_Msg_Name_1 := - Projects.Table (Extending2).Name; - Error_Msg_Name_2 := Projects.Table (Proj).Name; + In_Tree.Projects.Table (Extending2).Name; + Error_Msg_Name_2 := + In_Tree.Projects.Table (Proj).Name; if Error_Report = null then Error_Msg ("project % cannot extend project %", - Projects.Table (Extending2).Location); + In_Tree.Projects.Table (Extending2).Location); Error_Msg ("\they share the same object directory", - Projects.Table (Extending2).Location); + In_Tree.Projects.Table (Extending2).Location); else Error_Report @@ -965,17 +1093,18 @@ package body Prj.Proc is Get_Name_String (Error_Msg_Name_1) & """ cannot extend project """ & Get_Name_String (Error_Msg_Name_2) & """", - Project); + Project, In_Tree); Error_Report ("they share the same object directory", - Project); + Project, In_Tree); end if; end if; end if; -- Continue with the next extending project, if any - Extending2 := Projects.Table (Extending2).Extended_By; + Extending2 := + In_Tree.Projects.Table (Extending2).Extended_By; end loop; end if; end loop; @@ -989,10 +1118,12 @@ package body Prj.Proc is ------------------------------- procedure Process_Declarative_Items - (Project : Project_Id; - From_Project_Node : Project_Node_Id; - Pkg : Package_Id; - Item : Project_Node_Id) + (Project : Project_Id; + In_Tree : Project_Tree_Ref; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Pkg : Package_Id; + Item : Project_Node_Id) is Current_Declarative_Item : Project_Node_Id := Item; Current_Item : Project_Node_Id := Empty_Node; @@ -1004,50 +1135,61 @@ package body Prj.Proc is -- Get its data - Current_Item := Current_Item_Node (Current_Declarative_Item); + Current_Item := + Current_Item_Node + (Current_Declarative_Item, From_Project_Node_Tree); -- And set Current_Declarative_Item to the next declarative item -- ready for the next iteration. - Current_Declarative_Item := Next_Declarative_Item - (Current_Declarative_Item); + Current_Declarative_Item := + Next_Declarative_Item + (Current_Declarative_Item, From_Project_Node_Tree); - case Kind_Of (Current_Item) is + case Kind_Of (Current_Item, From_Project_Node_Tree) is when N_Package_Declaration => -- Do not process a package declaration that should be ignored - if Expression_Kind_Of (Current_Item) /= Ignored then + if Expression_Kind_Of + (Current_Item, From_Project_Node_Tree) /= Ignored + then -- Create the new package - Packages.Increment_Last; + Package_Table.Increment_Last (In_Tree.Packages); declare - New_Pkg : constant Package_Id := Packages.Last; + New_Pkg : constant Package_Id := + Package_Table.Last (In_Tree.Packages); The_New_Package : Package_Element; - Project_Of_Renamed_Package : constant Project_Node_Id := - Project_Of_Renamed_Package_Of - (Current_Item); + Project_Of_Renamed_Package : + constant Project_Node_Id := + Project_Of_Renamed_Package_Of + (Current_Item, From_Project_Node_Tree); begin -- Set the name of the new package - The_New_Package.Name := Name_Of (Current_Item); + The_New_Package.Name := + Name_Of (Current_Item, From_Project_Node_Tree); -- Insert the new package in the appropriate list if Pkg /= No_Package then The_New_Package.Next := - Packages.Table (Pkg).Decl.Packages; - Packages.Table (Pkg).Decl.Packages := New_Pkg; + In_Tree.Packages.Table (Pkg).Decl.Packages; + In_Tree.Packages.Table (Pkg).Decl.Packages := + New_Pkg; else The_New_Package.Next := - Projects.Table (Project).Decl.Packages; - Projects.Table (Project).Decl.Packages := New_Pkg; + In_Tree.Projects.Table (Project).Decl.Packages; + In_Tree.Projects.Table (Project).Decl.Packages := + New_Pkg; end if; - Packages.Table (New_Pkg) := The_New_Package; + In_Tree.Packages.Table (New_Pkg) := + The_New_Package; if Project_Of_Renamed_Package /= Empty_Node then @@ -1055,24 +1197,28 @@ package body Prj.Proc is declare Project_Name : constant Name_Id := - Name_Of - (Project_Of_Renamed_Package); + Name_Of + (Project_Of_Renamed_Package, + From_Project_Node_Tree); - Renamed_Project : constant Project_Id := - Imported_Or_Extended_Project_From - (Project, Project_Name); + Renamed_Project : + constant Project_Id := + Imported_Or_Extended_Project_From + (Project, In_Tree, Project_Name); Renamed_Package : constant Package_Id := - Package_From - (Renamed_Project, - Name_Of (Current_Item)); + Package_From + (Renamed_Project, In_Tree, + Name_Of + (Current_Item, + From_Project_Node_Tree)); begin -- For a renamed package, set declarations to -- the declarations of the renamed package. - Packages.Table (New_Pkg).Decl := - Packages.Table (Renamed_Package).Decl; + In_Tree.Packages.Table (New_Pkg).Decl := + In_Tree.Packages.Table (Renamed_Package).Decl; end; -- Standard package declaration, not renaming @@ -1081,19 +1227,23 @@ package body Prj.Proc is -- Set the default values of the attributes Add_Attributes - (Project, - Packages.Table (New_Pkg).Decl, + (Project, In_Tree, + In_Tree.Packages.Table (New_Pkg).Decl, First_Attribute_Of - (Package_Id_Of (Current_Item))); + (Package_Id_Of + (Current_Item, From_Project_Node_Tree))); -- And process declarative items of the new package Process_Declarative_Items - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => New_Pkg, - Item => First_Declarative_Item_Of - (Current_Item)); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => New_Pkg, + Item => + First_Declarative_Item_Of + (Current_Item, From_Project_Node_Tree)); end if; end; end if; @@ -1108,13 +1258,15 @@ package body Prj.Proc is N_Typed_Variable_Declaration | N_Variable_Declaration => - if Expression_Of (Current_Item) = Empty_Node then + if Expression_Of (Current_Item, From_Project_Node_Tree) = + Empty_Node + then -- It must be a full associative array attribute declaration declare Current_Item_Name : constant Name_Id := - Name_Of (Current_Item); + Name_Of (Current_Item, From_Project_Node_Tree); -- The name of the attribute New_Array : Array_Id; @@ -1160,48 +1312,65 @@ package body Prj.Proc is -- has elements declared. if Pkg /= No_Package then - New_Array := Packages.Table (Pkg).Decl.Arrays; + New_Array := In_Tree.Packages.Table + (Pkg).Decl.Arrays; else - New_Array := Projects.Table (Project).Decl.Arrays; + New_Array := In_Tree.Projects.Table + (Project).Decl.Arrays; end if; - while New_Array /= No_Array and then - Arrays.Table (New_Array).Name /= Current_Item_Name + while New_Array /= No_Array + and then In_Tree.Arrays.Table (New_Array).Name /= + Current_Item_Name loop - New_Array := Arrays.Table (New_Array).Next; + New_Array := In_Tree.Arrays.Table (New_Array).Next; end loop; -- If the attribute has never been declared add new entry -- in the arrays of the project/package and link it. if New_Array = No_Array then - Arrays.Increment_Last; - New_Array := Arrays.Last; + Array_Table.Increment_Last (In_Tree.Arrays); + New_Array := Array_Table.Last (In_Tree.Arrays); if Pkg /= No_Package then - Arrays.Table (New_Array) := + In_Tree.Arrays.Table (New_Array) := (Name => Current_Item_Name, Value => No_Array_Element, - Next => Packages.Table (Pkg).Decl.Arrays); - Packages.Table (Pkg).Decl.Arrays := New_Array; + Next => + In_Tree.Packages.Table (Pkg).Decl.Arrays); + + In_Tree.Packages.Table (Pkg).Decl.Arrays := + New_Array; else - Arrays.Table (New_Array) := + In_Tree.Arrays.Table (New_Array) := (Name => Current_Item_Name, Value => No_Array_Element, - Next => Projects.Table (Project).Decl.Arrays); - Projects.Table (Project).Decl.Arrays := New_Array; + Next => + In_Tree.Projects.Table (Project).Decl.Arrays); + + In_Tree.Projects.Table (Project).Decl.Arrays := + New_Array; end if; end if; -- Find the project where the value is declared Orig_Project_Name := - Name_Of (Associative_Project_Of (Current_Item)); - - for Index in Projects.First .. Projects.Last loop - if Projects.Table (Index).Name = Orig_Project_Name then + Name_Of + (Associative_Project_Of + (Current_Item, From_Project_Node_Tree), + From_Project_Node_Tree); + + for Index in Project_Table.First .. + Project_Table.Last + (In_Tree.Projects) + loop + if In_Tree.Projects.Table (Index).Name = + Orig_Project_Name + then Orig_Project := Index; exit; end if; @@ -1210,55 +1379,69 @@ package body Prj.Proc is pragma Assert (Orig_Project /= No_Project, "original project not found"); - if Associative_Package_Of (Current_Item) = Empty_Node then + if Associative_Package_Of + (Current_Item, From_Project_Node_Tree) = Empty_Node + then Orig_Array := - Projects.Table (Orig_Project).Decl.Arrays; + In_Tree.Projects.Table + (Orig_Project).Decl.Arrays; else -- If in a package, find the package where the -- value is declared. Orig_Package_Name := - Name_Of (Associative_Package_Of (Current_Item)); + Name_Of + (Associative_Package_Of + (Current_Item, From_Project_Node_Tree), + From_Project_Node_Tree); + Orig_Package := - Projects.Table (Orig_Project).Decl.Packages; + In_Tree.Projects.Table + (Orig_Project).Decl.Packages; pragma Assert (Orig_Package /= No_Package, "original package not found"); - while Packages.Table (Orig_Package).Name /= - Orig_Package_Name + while In_Tree.Packages.Table + (Orig_Package).Name /= Orig_Package_Name loop - Orig_Package := Packages.Table (Orig_Package).Next; + Orig_Package := In_Tree.Packages.Table + (Orig_Package).Next; pragma Assert (Orig_Package /= No_Package, "original package not found"); end loop; Orig_Array := - Packages.Table (Orig_Package).Decl.Arrays; + In_Tree.Packages.Table + (Orig_Package).Decl.Arrays; end if; -- Now look for the array while Orig_Array /= No_Array and then - Arrays.Table (Orig_Array).Name /= Current_Item_Name + In_Tree.Arrays.Table (Orig_Array).Name /= + Current_Item_Name loop - Orig_Array := Arrays.Table (Orig_Array).Next; + Orig_Array := In_Tree.Arrays.Table + (Orig_Array).Next; end loop; if Orig_Array = No_Array then if Error_Report = null then Error_Msg ("associative array value cannot be found", - Location_Of (Current_Item)); + Location_Of + (Current_Item, From_Project_Node_Tree)); else Error_Report ("associative array value cannot be found", - Project); + Project, In_Tree); end if; else - Orig_Element := Arrays.Table (Orig_Array).Value; + Orig_Element := + In_Tree.Arrays.Table (Orig_Array).Value; -- Copy each array element @@ -1271,20 +1454,25 @@ package body Prj.Proc is -- And there is no array element declared yet, -- create a new first array element. - if Arrays.Table (New_Array).Value = + if In_Tree.Arrays.Table (New_Array).Value = No_Array_Element then - Array_Elements.Increment_Last; - New_Element := Array_Elements.Last; - Arrays.Table (New_Array).Value := New_Element; + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + New_Element := Array_Element_Table.Last + (In_Tree.Array_Elements); + In_Tree.Arrays.Table + (New_Array).Value := New_Element; Next_Element := No_Array_Element; -- Otherwise, the new element is the first else - New_Element := Arrays.Table (New_Array).Value; + New_Element := In_Tree.Arrays. + Table (New_Array).Value; Next_Element := - Array_Elements.Table (New_Element).Next; + In_Tree.Array_Elements.Table + (New_Element).Next; end if; -- Otherwise, reuse an existing element, or create @@ -1292,30 +1480,36 @@ package body Prj.Proc is else Next_Element := - Array_Elements.Table (Prev_Element).Next; + In_Tree.Array_Elements.Table + (Prev_Element).Next; if Next_Element = No_Array_Element then - Array_Elements.Increment_Last; - New_Element := Array_Elements.Last; + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + New_Element := Array_Element_Table.Last + (In_Tree.Array_Elements); else New_Element := Next_Element; Next_Element := - Array_Elements.Table (New_Element).Next; + In_Tree.Array_Elements.Table + (New_Element).Next; end if; end if; -- Copy the value of the element - Array_Elements.Table (New_Element) := - Array_Elements.Table (Orig_Element); - Array_Elements.Table (New_Element).Value.Project := - Project; + In_Tree.Array_Elements.Table + (New_Element) := + In_Tree.Array_Elements.Table + (Orig_Element); + In_Tree.Array_Elements.Table + (New_Element).Value.Project := Project; -- Adjust the Next link - Array_Elements.Table (New_Element).Next := - Next_Element; + In_Tree.Array_Elements.Table + (New_Element).Next := Next_Element; -- Adjust the previous id for the next element @@ -1324,14 +1518,15 @@ package body Prj.Proc is -- Go to the next element in the original array Orig_Element := - Array_Elements.Table (Orig_Element).Next; + In_Tree.Array_Elements.Table + (Orig_Element).Next; end loop; -- Make sure that the array ends here, in case there -- previously a greater number of elements. - Array_Elements.Table (New_Element).Next := - No_Array_Element; + In_Tree.Array_Elements.Table + (New_Element).Next := No_Array_Element; end if; end; @@ -1341,62 +1536,73 @@ package body Prj.Proc is declare New_Value : constant Variable_Value := Expression - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - First_Term => - Tree.First_Term (Expression_Of - (Current_Item)), - Kind => - Expression_Kind_Of (Current_Item)); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + First_Term => + Tree.First_Term + (Expression_Of + (Current_Item, From_Project_Node_Tree), + From_Project_Node_Tree), + Kind => + Expression_Kind_Of + (Current_Item, From_Project_Node_Tree)); -- The expression value The_Variable : Variable_Id := No_Variable; Current_Item_Name : constant Name_Id := - Name_Of (Current_Item); + Name_Of (Current_Item, From_Project_Node_Tree); begin -- Process a typed variable declaration - if - Kind_Of (Current_Item) = N_Typed_Variable_Declaration + if Kind_Of (Current_Item, From_Project_Node_Tree) = + N_Typed_Variable_Declaration then -- Report an error for an empty string if New_Value.Value = Empty_String then - Error_Msg_Name_1 := Name_Of (Current_Item); + Error_Msg_Name_1 := + Name_Of (Current_Item, From_Project_Node_Tree); if Error_Report = null then Error_Msg ("no value defined for %", - Location_Of (Current_Item)); + Location_Of + (Current_Item, From_Project_Node_Tree)); else Error_Report ("no value defined for " & Get_Name_String (Error_Msg_Name_1), - Project); + Project, In_Tree); end if; else declare Current_String : Project_Node_Id := - First_Literal_String - (String_Type_Of - (Current_Item)); + First_Literal_String + (String_Type_Of + (Current_Item, + From_Project_Node_Tree), + From_Project_Node_Tree); begin - -- Loop through all the valid strings for - -- the string type and compare to the string - -- value. + -- Loop through all the valid strings for the + -- string type and compare to the string value. while Current_String /= Empty_Node - and then String_Value_Of (Current_String) /= - New_Value.Value + and then + String_Value_Of + (Current_String, From_Project_Node_Tree) /= + New_Value.Value loop Current_String := - Next_Literal_String (Current_String); + Next_Literal_String + (Current_String, From_Project_Node_Tree); end loop; -- Report an error if the string value is not @@ -1404,12 +1610,16 @@ package body Prj.Proc is if Current_String = Empty_Node then Error_Msg_Name_1 := New_Value.Value; - Error_Msg_Name_2 := Name_Of (Current_Item); + Error_Msg_Name_2 := + Name_Of + (Current_Item, From_Project_Node_Tree); if Error_Report = null then Error_Msg ("value { is illegal for typed string %", - Location_Of (Current_Item)); + Location_Of + (Current_Item, + From_Project_Node_Tree)); else Error_Report @@ -1418,16 +1628,18 @@ package body Prj.Proc is """ is illegal for typed string """ & Get_Name_String (Error_Msg_Name_2) & """", - Project); + Project, In_Tree); end if; end if; end; end if; end if; - if Kind_Of (Current_Item) /= N_Attribute_Declaration + if Kind_Of (Current_Item, From_Project_Node_Tree) /= + N_Attribute_Declaration or else - Associative_Array_Index_Of (Current_Item) = No_Name + Associative_Array_Index_Of + (Current_Item, From_Project_Node_Tree) = No_Name then -- Case of a variable declaration or of a not -- associative array attribute. @@ -1435,26 +1647,28 @@ package body Prj.Proc is -- First, find the list where to find the variable -- or attribute. - if - Kind_Of (Current_Item) = N_Attribute_Declaration + if Kind_Of (Current_Item, From_Project_Node_Tree) = + N_Attribute_Declaration then if Pkg /= No_Package then The_Variable := - Packages.Table (Pkg).Decl.Attributes; - + In_Tree.Packages.Table + (Pkg).Decl.Attributes; else The_Variable := - Projects.Table (Project).Decl.Attributes; + In_Tree.Projects.Table + (Project).Decl.Attributes; end if; else if Pkg /= No_Package then The_Variable := - Packages.Table (Pkg).Decl.Variables; - + In_Tree.Packages.Table + (Pkg).Decl.Variables; else The_Variable := - Projects.Table (Project).Decl.Variables; + In_Tree.Projects.Table + (Project).Decl.Variables; end if; end if; @@ -1462,58 +1676,65 @@ package body Prj.Proc is -- Loop through the list, to find if it has already -- been declared. - while - The_Variable /= No_Variable + while The_Variable /= No_Variable and then - Variable_Elements.Table (The_Variable).Name /= - Current_Item_Name + In_Tree.Variable_Elements.Table + (The_Variable).Name /= Current_Item_Name loop The_Variable := - Variable_Elements.Table (The_Variable).Next; + In_Tree.Variable_Elements.Table + (The_Variable).Next; end loop; -- If it has not been declared, create a new entry -- in the list. if The_Variable = No_Variable then + -- All single string attribute should already have -- been declared with a default empty string value. pragma Assert - (Kind_Of (Current_Item) /= + (Kind_Of (Current_Item, From_Project_Node_Tree) /= N_Attribute_Declaration, "illegal attribute declaration"); - Variable_Elements.Increment_Last; - The_Variable := Variable_Elements.Last; + Variable_Element_Table.Increment_Last + (In_Tree.Variable_Elements); + The_Variable := Variable_Element_Table.Last + (In_Tree.Variable_Elements); -- Put the new variable in the appropriate list if Pkg /= No_Package then - Variable_Elements.Table (The_Variable) := + In_Tree.Variable_Elements.Table (The_Variable) := (Next => - Packages.Table (Pkg).Decl.Variables, + In_Tree.Packages.Table + (Pkg).Decl.Variables, Name => Current_Item_Name, Value => New_Value); - Packages.Table (Pkg).Decl.Variables := - The_Variable; + In_Tree.Packages.Table + (Pkg).Decl.Variables := The_Variable; else - Variable_Elements.Table (The_Variable) := + In_Tree.Variable_Elements.Table (The_Variable) := (Next => - Projects.Table (Project).Decl.Variables, + In_Tree.Projects.Table + (Project).Decl.Variables, Name => Current_Item_Name, Value => New_Value); - Projects.Table (Project).Decl.Variables := - The_Variable; + In_Tree.Projects.Table + (Project).Decl.Variables := + The_Variable; end if; -- If the variable/attribute has already been -- declared, just change the value. else - Variable_Elements.Table (The_Variable).Value := - New_Value; + In_Tree.Variable_Elements.Table + (The_Variable).Value := + New_Value; end if; @@ -1523,11 +1744,14 @@ package body Prj.Proc is -- Get the string index Get_Name_String - (Associative_Array_Index_Of (Current_Item)); + (Associative_Array_Index_Of + (Current_Item, From_Project_Node_Tree)); -- Put in lower case, if necessary - if Case_Insensitive (Current_Item) then + if Case_Insensitive + (Current_Item, From_Project_Node_Tree) + then GNAT.Case_Util.To_Lower (Name_Buffer (1 .. Name_Len)); end if; @@ -1536,7 +1760,7 @@ package body Prj.Proc is The_Array : Array_Id; The_Array_Element : Array_Element_Id := - No_Array_Element; + No_Array_Element; Index_Name : constant Name_Id := Name_Find; -- The name id of the index @@ -1545,19 +1769,21 @@ package body Prj.Proc is -- Look for the array in the appropriate list if Pkg /= No_Package then - The_Array := Packages.Table (Pkg).Decl.Arrays; + The_Array := In_Tree.Packages.Table + (Pkg).Decl.Arrays; else - The_Array := Projects.Table + The_Array := In_Tree.Projects.Table (Project).Decl.Arrays; end if; while The_Array /= No_Array - and then Arrays.Table (The_Array).Name /= - Current_Item_Name + and then In_Tree.Arrays.Table + (The_Array).Name /= Current_Item_Name loop - The_Array := Arrays.Table (The_Array).Next; + The_Array := In_Tree.Arrays.Table + (The_Array).Next; end loop; -- If the array cannot be found, create a new @@ -1566,24 +1792,36 @@ package body Prj.Proc is -- will be created automatically later. if The_Array = No_Array then - Arrays.Increment_Last; - The_Array := Arrays.Last; + Array_Table.Increment_Last + (In_Tree.Arrays); + The_Array := Array_Table.Last + (In_Tree.Arrays); if Pkg /= No_Package then - Arrays.Table (The_Array) := + In_Tree.Arrays.Table + (The_Array) := (Name => Current_Item_Name, Value => No_Array_Element, - Next => Packages.Table (Pkg).Decl.Arrays); - Packages.Table (Pkg).Decl.Arrays := The_Array; + Next => + In_Tree.Packages.Table + (Pkg).Decl.Arrays); + + In_Tree.Packages.Table + (Pkg).Decl.Arrays := + The_Array; else - Arrays.Table (The_Array) := + In_Tree.Arrays.Table + (The_Array) := (Name => Current_Item_Name, Value => No_Array_Element, Next => - Projects.Table (Project).Decl.Arrays); - Projects.Table (Project).Decl.Arrays := - The_Array; + In_Tree.Projects.Table + (Project).Decl.Arrays); + + In_Tree.Projects.Table + (Project).Decl.Arrays := + The_Array; end if; -- Otherwise, initialize The_Array_Element as the @@ -1591,7 +1829,8 @@ package body Prj.Proc is else The_Array_Element := - Arrays.Table (The_Array).Value; + In_Tree.Arrays.Table + (The_Array).Value; end if; -- Look in the list, if any, to find an element @@ -1599,11 +1838,12 @@ package body Prj.Proc is while The_Array_Element /= No_Array_Element and then - Array_Elements.Table (The_Array_Element).Index /= - Index_Name + In_Tree.Array_Elements.Table + (The_Array_Element).Index /= Index_Name loop The_Array_Element := - Array_Elements.Table (The_Array_Element).Next; + In_Tree.Array_Elements.Table + (The_Array_Element).Next; end loop; -- If no such element were found, create a new @@ -1611,25 +1851,32 @@ package body Prj.Proc is -- the propoer value. if The_Array_Element = No_Array_Element then - Array_Elements.Increment_Last; - The_Array_Element := Array_Elements.Last; + Array_Element_Table.Increment_Last + (In_Tree.Array_Elements); + The_Array_Element := Array_Element_Table.Last + (In_Tree.Array_Elements); - Array_Elements.Table (The_Array_Element) := + In_Tree.Array_Elements.Table + (The_Array_Element) := (Index => Index_Name, - Src_Index => Source_Index_Of (Current_Item), + Src_Index => + Source_Index_Of + (Current_Item, From_Project_Node_Tree), Index_Case_Sensitive => - not Case_Insensitive (Current_Item), + not Case_Insensitive + (Current_Item, From_Project_Node_Tree), Value => New_Value, - Next => Arrays.Table (The_Array).Value); - Arrays.Table (The_Array).Value := - The_Array_Element; + Next => In_Tree.Arrays.Table + (The_Array).Value); + In_Tree.Arrays.Table + (The_Array).Value := The_Array_Element; -- An element with the same index already exists, -- just replace its value with the new one. else - Array_Elements.Table (The_Array_Element).Value := - New_Value; + In_Tree.Array_Elements.Table + (The_Array_Element).Value := New_Value; end if; end; end if; @@ -1658,7 +1905,8 @@ package body Prj.Proc is declare Variable_Node : constant Project_Node_Id := Case_Variable_Reference_Of - (Current_Item); + (Current_Item, + From_Project_Node_Tree); Var_Id : Variable_Id := No_Variable; Name : Name_Id := No_Name; @@ -1667,33 +1915,51 @@ package body Prj.Proc is -- If a project were specified for the case variable, -- get its id. - if Project_Node_Of (Variable_Node) /= Empty_Node then - Name := Name_Of (Project_Node_Of (Variable_Node)); + if Project_Node_Of + (Variable_Node, From_Project_Node_Tree) /= Empty_Node + then + Name := + Name_Of + (Project_Node_Of + (Variable_Node, From_Project_Node_Tree), + From_Project_Node_Tree); The_Project := - Imported_Or_Extended_Project_From (Project, Name); + Imported_Or_Extended_Project_From + (Project, In_Tree, Name); end if; -- If a package were specified for the case variable, -- get its id. - if Package_Node_Of (Variable_Node) /= Empty_Node then - Name := Name_Of (Package_Node_Of (Variable_Node)); - The_Package := Package_From (The_Project, Name); + if Package_Node_Of + (Variable_Node, From_Project_Node_Tree) /= Empty_Node + then + Name := + Name_Of + (Package_Node_Of + (Variable_Node, From_Project_Node_Tree), + From_Project_Node_Tree); + The_Package := + Package_From (The_Project, In_Tree, Name); end if; - Name := Name_Of (Variable_Node); + Name := Name_Of (Variable_Node, From_Project_Node_Tree); -- First, look for the case variable into the package, -- if any. if The_Package /= No_Package then - Var_Id := Packages.Table (The_Package).Decl.Variables; - Name := Name_Of (Variable_Node); + Var_Id := In_Tree.Packages.Table + (The_Package).Decl.Variables; + Name := + Name_Of (Variable_Node, From_Project_Node_Tree); while Var_Id /= No_Variable and then - Variable_Elements.Table (Var_Id).Name /= Name + In_Tree.Variable_Elements.Table + (Var_Id).Name /= Name loop - Var_Id := Variable_Elements.Table (Var_Id).Next; + Var_Id := In_Tree.Variable_Elements. + Table (Var_Id).Next; end loop; end if; @@ -1701,14 +1967,19 @@ package body Prj.Proc is -- package, look at the project level. if Var_Id = No_Variable - and then Package_Node_Of (Variable_Node) = Empty_Node + and then + Package_Node_Of + (Variable_Node, From_Project_Node_Tree) = Empty_Node then - Var_Id := Projects.Table (The_Project).Decl.Variables; + Var_Id := In_Tree.Projects.Table + (The_Project).Decl.Variables; while Var_Id /= No_Variable and then - Variable_Elements.Table (Var_Id).Name /= Name + In_Tree.Variable_Elements.Table + (Var_Id).Name /= Name loop - Var_Id := Variable_Elements.Table (Var_Id).Next; + Var_Id := In_Tree.Variable_Elements. + Table (Var_Id).Next; end loop; end if; @@ -1725,7 +1996,8 @@ package body Prj.Proc is -- Get the case variable - The_Variable := Variable_Elements.Table (Var_Id).Value; + The_Variable := In_Tree.Variable_Elements. + Table (Var_Id).Value; if The_Variable.Kind /= Single then @@ -1744,16 +2016,20 @@ package body Prj.Proc is -- Now look into all the case items of the case construction - Case_Item := First_Case_Item_Of (Current_Item); + Case_Item := + First_Case_Item_Of (Current_Item, From_Project_Node_Tree); Case_Item_Loop : while Case_Item /= Empty_Node loop - Choice_String := First_Choice_Of (Case_Item); + 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 - Decl_Item := First_Declarative_Item_Of (Case_Item); + Decl_Item := + First_Declarative_Item_Of + (Case_Item, From_Project_Node_Tree); exit Case_Item_Loop; end if; @@ -1761,28 +2037,35 @@ package body Prj.Proc is Choice_Loop : while Choice_String /= Empty_Node loop - if - Case_Value = String_Value_Of (Choice_String) + if Case_Value = + String_Value_Of + (Choice_String, From_Project_Node_Tree) then Decl_Item := - First_Declarative_Item_Of (Case_Item); + First_Declarative_Item_Of + (Case_Item, From_Project_Node_Tree); exit Case_Item_Loop; end if; Choice_String := - Next_Literal_String (Choice_String); + Next_Literal_String + (Choice_String, From_Project_Node_Tree); end loop Choice_Loop; - Case_Item := Next_Case_Item (Case_Item); + + Case_Item := + Next_Case_Item (Case_Item, From_Project_Node_Tree); end loop Case_Item_Loop; -- If there is an alternative, then we process it if Decl_Item /= Empty_Node then Process_Declarative_Items - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => Pkg, - Item => Decl_Item); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => Pkg, + Item => Decl_Item); end if; end; @@ -1791,7 +2074,9 @@ package body Prj.Proc is -- Should never happen Write_Line ("Illegal declarative item: " & - Project_Node_Kind'Image (Kind_Of (Current_Item))); + Project_Node_Kind'Image + (Kind_Of + (Current_Item, From_Project_Node_Tree))); raise Program_Error; end case; end loop; @@ -1803,6 +2088,7 @@ package body Prj.Proc is procedure Recursive_Check (Project : Project_Id; + In_Tree : Project_Tree_Ref; Follow_Links : Boolean) is Data : Project_Data; @@ -1813,29 +2099,31 @@ package body Prj.Proc is -- been marked as checked. if Project /= No_Project - and then not Projects.Table (Project).Checked + and then not In_Tree.Projects.Table (Project).Checked then -- Mark project as checked, to avoid infinite recursion in -- ill-formed trees, where a project imports itself. - Projects.Table (Project).Checked := True; + In_Tree.Projects.Table (Project).Checked := True; - Data := Projects.Table (Project); + Data := In_Tree.Projects.Table (Project); -- Call itself for a possible extended project. -- (if there is no extended project, then nothing happens). - Recursive_Check (Data.Extends, Follow_Links); + Recursive_Check (Data.Extends, In_Tree, Follow_Links); -- Call itself for all imported projects Imported_Project_List := Data.Imported_Projects; while Imported_Project_List /= Empty_Project_List loop Recursive_Check - (Project_Lists.Table (Imported_Project_List).Project, - Follow_Links); + (In_Tree.Project_Lists.Table + (Imported_Project_List).Project, + In_Tree, Follow_Links); Imported_Project_List := - Project_Lists.Table (Imported_Project_List).Next; + In_Tree.Project_Lists.Table + (Imported_Project_List).Next; end loop; if Opt.Verbose_Mode then @@ -1844,7 +2132,7 @@ package body Prj.Proc is Write_Line (""""); end if; - Prj.Nmsc.Check (Project, Error_Report, Follow_Links); + Prj.Nmsc.Check (Project, In_Tree, Error_Report, Follow_Links); end if; end Recursive_Check; @@ -1853,9 +2141,11 @@ package body Prj.Proc is ----------------------- procedure Recursive_Process - (Project : out Project_Id; - From_Project_Node : Project_Node_Id; - Extended_By : Project_Id) + (In_Tree : Project_Tree_Ref; + Project : out Project_Id; + From_Project_Node : Project_Node_Id; + From_Project_Node_Tree : Project_Node_Tree_Ref; + Extended_By : Project_Id) is With_Clause : Project_Node_Id; @@ -1865,10 +2155,11 @@ package body Prj.Proc is else declare - Processed_Data : Project_Data := Empty_Project; + Processed_Data : Project_Data := Empty_Project (In_Tree); Imported : Project_List := Empty_Project_List; Declaration_Node : Project_Node_Id := Empty_Node; - Name : constant Name_Id := Name_Of (From_Project_Node); + Name : constant Name_Id := + Name_Of (From_Project_Node, From_Project_Node_Tree); begin Project := Processed_Projects.Get (Name); @@ -1877,8 +2168,8 @@ package body Prj.Proc is return; end if; - Projects.Increment_Last; - Project := Projects.Last; + Project_Table.Increment_Last (In_Tree.Projects); + Project := Project_Table.Last (In_Tree.Projects); Processed_Projects.Set (Name, Project); Processed_Data.Name := Name; @@ -1896,15 +2187,16 @@ package body Prj.Proc is end if; Processed_Data.Display_Path_Name := - Path_Name_Of (From_Project_Node); + Path_Name_Of (From_Project_Node, From_Project_Node_Tree); Get_Name_String (Processed_Data.Display_Path_Name); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Processed_Data.Path_Name := Name_Find; - Processed_Data.Location := Location_Of (From_Project_Node); + Processed_Data.Location := + Location_Of (From_Project_Node, From_Project_Node_Tree); Processed_Data.Display_Directory := - Directory_Of (From_Project_Node); + Directory_Of (From_Project_Node, From_Project_Node_Tree); Get_Name_String (Processed_Data.Display_Directory); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Processed_Data.Directory := Name_Find; @@ -1912,8 +2204,10 @@ package body Prj.Proc is Processed_Data.Extended_By := Extended_By; Processed_Data.Naming := Standard_Naming_Data; - Add_Attributes (Project, Processed_Data.Decl, Attribute_First); - With_Clause := First_With_Clause_Of (From_Project_Node); + Add_Attributes + (Project, In_Tree, Processed_Data.Decl, Attribute_First); + With_Clause := + First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree); while With_Clause /= Empty_Node loop declare @@ -1922,56 +2216,79 @@ package body Prj.Proc is begin Recursive_Process - (Project => New_Project, - From_Project_Node => Project_Node_Of (With_Clause), - Extended_By => No_Project); - New_Data := Projects.Table (New_Project); + (In_Tree => In_Tree, + Project => New_Project, + From_Project_Node => + Project_Node_Of (With_Clause, From_Project_Node_Tree), + From_Project_Node_Tree => From_Project_Node_Tree, + Extended_By => No_Project); + New_Data := + In_Tree.Projects.Table (New_Project); -- If we were the first project to import it, -- set First_Referred_By to us. if New_Data.First_Referred_By = No_Project then New_Data.First_Referred_By := Project; - Projects.Table (New_Project) := New_Data; + In_Tree.Projects.Table (New_Project) := + New_Data; end if; -- Add this project to our list of imported projects - Project_Lists.Increment_Last; - Project_Lists.Table (Project_Lists.Last) := + Project_List_Table.Increment_Last + (In_Tree.Project_Lists); + In_Tree.Project_Lists.Table + (Project_List_Table.Last + (In_Tree.Project_Lists)) := (Project => New_Project, Next => Empty_Project_List); -- Imported is the id of the last imported project. -- If it is nil, then this imported project is our first. if Imported = Empty_Project_List then - Processed_Data.Imported_Projects := Project_Lists.Last; + Processed_Data.Imported_Projects := + Project_List_Table.Last + (In_Tree.Project_Lists); else - Project_Lists.Table (Imported).Next := Project_Lists.Last; + In_Tree.Project_Lists.Table + (Imported).Next := Project_List_Table.Last + (In_Tree.Project_Lists); end if; - Imported := Project_Lists.Last; + Imported := Project_List_Table.Last + (In_Tree.Project_Lists); - With_Clause := Next_With_Clause_Of (With_Clause); + With_Clause := + Next_With_Clause_Of (With_Clause, From_Project_Node_Tree); end; end loop; - Declaration_Node := Project_Declaration_Of (From_Project_Node); + Declaration_Node := + Project_Declaration_Of + (From_Project_Node, From_Project_Node_Tree); Recursive_Process - (Project => Processed_Data.Extends, - From_Project_Node => Extended_Project_Of (Declaration_Node), - Extended_By => Project); + (In_Tree => In_Tree, + Project => Processed_Data.Extends, + From_Project_Node => + Extended_Project_Of + (Declaration_Node, From_Project_Node_Tree), + From_Project_Node_Tree => From_Project_Node_Tree, + Extended_By => Project); - Projects.Table (Project) := Processed_Data; + In_Tree.Projects.Table (Project) := Processed_Data; Process_Declarative_Items - (Project => Project, - From_Project_Node => From_Project_Node, - Pkg => No_Package, - Item => First_Declarative_Item_Of - (Declaration_Node)); + (Project => Project, + In_Tree => In_Tree, + From_Project_Node => From_Project_Node, + From_Project_Node_Tree => From_Project_Node_Tree, + Pkg => No_Package, + Item => + First_Declarative_Item_Of + (Declaration_Node, From_Project_Node_Tree)); -- If it is an extending project, inherit all packages -- from the extended project that are not explicitely defined @@ -1979,11 +2296,11 @@ package body Prj.Proc is -- is not explicitely defined. if Processed_Data.Extends /= No_Project then - Processed_Data := Projects.Table (Project); + Processed_Data := In_Tree.Projects.Table (Project); declare Extended_Pkg : Package_Id := - Projects.Table + In_Tree.Projects.Table (Processed_Data.Extends).Decl.Packages; Current_Pkg : Package_Id; Element : Package_Element; @@ -1996,21 +2313,25 @@ package body Prj.Proc is begin while Extended_Pkg /= No_Package loop - Element := Packages.Table (Extended_Pkg); + Element := + In_Tree.Packages.Table (Extended_Pkg); Current_Pkg := First; loop exit when Current_Pkg = No_Package - or else Packages.Table (Current_Pkg).Name - = Element.Name; - Current_Pkg := Packages.Table (Current_Pkg).Next; + or else In_Tree.Packages.Table + (Current_Pkg).Name = Element.Name; + Current_Pkg := In_Tree.Packages.Table + (Current_Pkg).Next; end loop; if Current_Pkg = No_Package then - Packages.Increment_Last; - Current_Pkg := Packages.Last; - Packages.Table (Current_Pkg) := + Package_Table.Increment_Last + (In_Tree.Packages); + Current_Pkg := Package_Table.Last + (In_Tree.Packages); + In_Tree.Packages.Table (Current_Pkg) := (Name => Element.Name, Decl => Element.Decl, Parent => No_Package, @@ -2026,7 +2347,8 @@ package body Prj.Proc is Attribute1 := Processed_Data.Decl.Attributes; while Attribute1 /= No_Variable loop - Attr_Value1 := Variable_Elements.Table (Attribute1); + Attr_Value1 := In_Tree.Variable_Elements. + Table (Attribute1); exit when Attr_Value1.Name = Snames.Name_Languages; Attribute1 := Attr_Value1.Next; end loop; @@ -2039,10 +2361,12 @@ package body Prj.Proc is -- extended. Attribute2 := - Projects.Table (Processed_Data.Extends).Decl.Attributes; + In_Tree.Projects.Table + (Processed_Data.Extends).Decl.Attributes; while Attribute2 /= No_Variable loop - Attr_Value2 := Variable_Elements.Table (Attribute2); + Attr_Value2 := In_Tree.Variable_Elements. + Table (Attribute2); exit when Attr_Value2.Name = Snames.Name_Languages; Attribute2 := Attr_Value2.Next; end loop; @@ -2055,20 +2379,23 @@ package body Prj.Proc is -- project. if Attribute1 = No_Variable then - Variable_Elements.Increment_Last; - Attribute1 := Variable_Elements.Last; + Variable_Element_Table.Increment_Last + (In_Tree.Variable_Elements); + Attribute1 := Variable_Element_Table.Last + (In_Tree.Variable_Elements); Attr_Value1.Next := Processed_Data.Decl.Attributes; Processed_Data.Decl.Attributes := Attribute1; end if; Attr_Value1.Name := Snames.Name_Languages; Attr_Value1.Value := Attr_Value2.Value; - Variable_Elements.Table (Attribute1) := Attr_Value1; + In_Tree.Variable_Elements.Table + (Attribute1) := Attr_Value1; end if; end if; end; - Projects.Table (Project) := Processed_Data; + In_Tree.Projects.Table (Project) := Processed_Data; end if; end; end if; |