diff options
Diffstat (limited to 'gcc/ada/prj-proc.adb')
| -rw-r--r-- | gcc/ada/prj-proc.adb | 214 |
1 files changed, 153 insertions, 61 deletions
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 35dace7a1bf..1a8bd23dc88 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -8,7 +8,7 @@ -- -- -- $Revision$ -- -- --- Copyright (C) 2001 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2002 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- -- @@ -36,7 +36,7 @@ with Prj.Ext; use Prj.Ext; with Prj.Nmsc; use Prj.Nmsc; with Stringt; use Stringt; -with GNAT.Case_Util; +with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.HTable; package body Prj.Proc is @@ -76,13 +76,13 @@ package body Prj.Proc is (Project : Project_Id; With_Name : Name_Id) return Project_Id; - -- Find an imported or modified project of Project whose name is With_Name. + -- Find an imported or modified project of Project whose name is With_Name function Package_From (Project : Project_Id; With_Name : Name_Id) return Package_Id; - -- Find the package of Project whose name is With_Name. + -- Find the package of Project whose name is With_Name procedure Process_Declarative_Items (Project : Project_Id; @@ -105,15 +105,13 @@ package body Prj.Proc is -- Then process the declarative items of the project. procedure Check (Project : in out Project_Id); - -- Set all projects to not checked, then call Recursive_Check for - -- the main project Project. - -- Project is set to No_Project if errors occurred. + -- Set all projects to not checked, then call Recursive_Check for the + -- main project Project. Project is set to No_Project if errors occurred. procedure Recursive_Check (Project : Project_Id); - -- If Project is marked as not checked, mark it as checked, - -- call Check_Naming_Scheme for the project, then call itself - -- for a possible modified project and all the imported projects - -- of Project. + -- If Project is marked as not checked, mark it as checked, call + -- Check_Naming_Scheme for the project, then call itself for a + -- possible modified project and all the imported projects of Project. --------- -- Add -- @@ -204,7 +202,7 @@ package body Prj.Proc is procedure Check (Project : in out Project_Id) is begin - -- Make sure that all projects are marked as not checked. + -- Make sure that all projects are marked as not checked for Index in 1 .. Projects.Last loop Projects.Table (Index).Checked := False; @@ -212,7 +210,7 @@ package body Prj.Proc is Recursive_Check (Project); - if Errout.Errors_Detected > 0 then + if Errout.Total_Errors_Detected > 0 then Project := No_Project; end if; @@ -376,11 +374,12 @@ package body Prj.Proc is The_Package : Package_Id := Pkg; The_Name : Name_Id := No_Name; The_Variable_Id : Variable_Id := No_Variable; - The_Variable : Variable; + The_Variable : Variable_Value; Term_Project : constant Project_Node_Id := Project_Node_Of (The_Current_Term); Term_Package : constant Project_Node_Id := Package_Node_Of (The_Current_Term); + Index : String_Id := No_String; begin if Term_Project /= Empty_Node and then @@ -416,58 +415,146 @@ package body Prj.Proc is The_Name := Name_Of (The_Current_Term); - if The_Package /= No_Package then + if Kind_Of (The_Current_Term) = N_Attribute_Reference then + Index := Associative_Array_Index_Of (The_Current_Term); + end if; - -- First, if there is a package, look into the package + -- If it is not an associative array attribute - if Kind_Of (The_Current_Term) = N_Variable_Reference then - The_Variable_Id := - Packages.Table (The_Package).Decl.Variables; + if Index = No_String then + + -- It is not an associative array attribute + + if The_Package /= No_Package then + + -- First, if there is a package, look into the package + + if + Kind_Of (The_Current_Term) = N_Variable_Reference + then + The_Variable_Id := + Packages.Table (The_Package).Decl.Variables; + + else + The_Variable_Id := + 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 + loop + The_Variable_Id := + Variable_Elements.Table (The_Variable_Id).Next; + end loop; - else - The_Variable_Id := - 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 - loop - The_Variable_Id := - Variable_Elements.Table (The_Variable_Id).Next; - end loop; + if The_Variable_Id = No_Variable then - end if; + -- If we have not found it, look into the project - if The_Variable_Id = No_Variable then + if + Kind_Of (The_Current_Term) = N_Variable_Reference + then + The_Variable_Id := + Projects.Table (The_Project).Decl.Variables; - -- If we have not found it, look into the project + else + The_Variable_Id := + Projects.Table (The_Project).Decl.Attributes; + end if; - if Kind_Of (The_Current_Term) = N_Variable_Reference then - The_Variable_Id := - Projects.Table (The_Project).Decl.Variables; + while The_Variable_Id /= No_Variable + and then + Variable_Elements.Table (The_Variable_Id).Name /= + The_Name + loop + The_Variable_Id := + Variable_Elements.Table (The_Variable_Id).Next; + end loop; - else - The_Variable_Id := - 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 - loop - The_Variable_Id := - Variable_Elements.Table (The_Variable_Id).Next; - end loop; + pragma Assert (The_Variable_Id /= No_Variable, + "variable or attribute not found"); - end if; + The_Variable := Variable_Elements.Table + (The_Variable_Id).Value; + + else - pragma Assert (The_Variable_Id /= No_Variable, - "variable or attribute not found"); + -- It is an associative array attribute - The_Variable := Variable_Elements.Table (The_Variable_Id); + declare + 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; + + else + The_Array := + Projects.Table (The_Project).Decl.Arrays; + end if; + + while The_Array /= No_Array + and then Arrays.Table (The_Array).Name /= The_Name + loop + The_Array := Arrays.Table (The_Array).Next; + end loop; + + if The_Array /= No_Array then + The_Element := Arrays.Table (The_Array).Value; + + String_To_Name_Buffer (Index); + + if Case_Insensitive (The_Current_Term) 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 + loop + The_Element := + 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; + + else + if + Expression_Kind_Of (The_Current_Term) = List + then + The_Variable := + (Kind => List, + Location => No_Location, + Default => True, + Values => Nil_String); + + else + The_Variable := + (Kind => Single, + Location => No_Location, + Default => True, + Value => Empty_String); + end if; + + end if; + + end; + + end if; case Kind is @@ -480,13 +567,13 @@ package body Prj.Proc is when Single => - case The_Variable.Value.Kind is + case The_Variable.Kind is when Undefined => null; when Single => - Add (Result.Value, The_Variable.Value.Value); + Add (Result.Value, The_Variable.Value); when List => @@ -501,7 +588,7 @@ package body Prj.Proc is end case; when List => - case The_Variable.Value.Kind is + case The_Variable.Kind is when Undefined => null; @@ -523,7 +610,7 @@ package body Prj.Proc is Last := String_Elements.Last; String_Elements.Table (Last) := - (Value => The_Variable.Value.Value, + (Value => The_Variable.Value, Location => Location_Of (The_Current_Term), Next => Nil_String); @@ -531,7 +618,7 @@ package body Prj.Proc is declare The_List : String_List_Id := - The_Variable.Value.Values; + The_Variable.Values; begin while The_List /= Nil_String loop @@ -591,7 +678,8 @@ package body Prj.Proc is else Error_Report ("""" & Get_Name_String (Name) & - """ is an undefined external reference"); + """ is an undefined external reference", + Project); end if; Value := Empty_String; @@ -742,14 +830,13 @@ package body Prj.Proc is From_Project_Node => From_Project_Node, Modified_By => No_Project); - if Errout.Errors_Detected > 0 then + if Errout.Total_Errors_Detected > 0 then Project := No_Project; end if; if Project /= No_Project then Check (Project); end if; - end Process; ------------------------------- @@ -894,7 +981,8 @@ package body Prj.Proc is else Error_Report ("no value defined for " & - Get_Name_String (Error_Msg_Name_1)); + Get_Name_String (Error_Msg_Name_1), + Project); end if; else @@ -930,7 +1018,8 @@ package body Prj.Proc is Get_Name_String (Error_Msg_Name_1) & """ is illegal for typed string """ & Get_Name_String (Error_Msg_Name_2) & - """"); + """", + Project); end if; end if; end; @@ -1301,11 +1390,14 @@ package body Prj.Proc is Projects.Increment_Last; Project := Projects.Last; Processed_Projects.Set (Name, Project); + Processed_Data.Name := Name; Processed_Data.Path_Name := Path_Name_Of (From_Project_Node); Processed_Data.Location := Location_Of (From_Project_Node); Processed_Data.Directory := Directory_Of (From_Project_Node); Processed_Data.Modified_By := Modified_By; + Processed_Data.Naming := Standard_Naming_Data; + Add_Attributes (Processed_Data.Decl, Attribute_First); With_Clause := First_With_Clause_Of (From_Project_Node); |