From 9080eb6bba3613f90aa8b0444a4eb07a4eda3a9d Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 8 Dec 2004 11:25:51 +0000 Subject: * make.adb (Check_Mains, Switches_Of): Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). Take into account Externally_Built attribute. * clean.adb (In_Extension_Chain): Always return False when one of the parameter is No_Project. (Clean_Project): Adapt to changes in package Prj (Lang_Ada => Ada_Language_Index). (Gnatclean): Adapt to change in package Prj.Pars (no parameter Process_Languages for procedure Parse). * gnatcmd.adb (Carg_Switches): New table. (GNATCmd): Put all switches following -cargs in the Carg_Switches table. Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * mlib-prj.adb: Adapt to changes in packages Prj and Prj.Com: type Header_Num and function Hash are now declared in package Prj, not Prj.Com. * prj.adb (Suffix_Of): New function. (Set (Suffix)): New procedure. (Hash): One function moved from Prj.Com (Is_Present, Language_Processing_Data_Of): New functions (Set): Two new procedures (Add_Language_Name, Display_Language_Name): New procedures * prj.ads: (Suffix_Of): New function (Set (Suffix)): New procedure Add several types and tables for multi-language support. (Header_Num): Type moved from Prj.Com (Hash): Two functions moved from Prj.Com (Is_Present, Language_Processing_Data_Of): New functions (Set): Two new procedures (Add_Language_Name, Display_Language_Name): New procedures (Naming): Component name changes: Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix. Add new components: Impl_Suffixes, Supp_Suffixes. (Project_Data): New components: Externally_Built, Supp_Languages, First_Language_Processing, Supp_Language_Processing, Default_Linker, Default_Linker_Path. * prj-attr.adb: Add new attributes Ada_Roots and Externally_Built and new package Language_Processing with its attributes (Compiler_Driver, Compiler_Kind, Dependency_Option, Compute_Dependency, Include_Option, Binder_Driver, Default_Linker). * prj-com.ads, prj-com.adb (Hash): Function moved to package Prj. (Header_Num): Type moved to package Prj * prj-env.adb: Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * prj-ext.adb: Add the default project dir (/log/gnat) by default to the project path, except the "-" is one of the directories in env var ADA_PROJECT_PATH. (Current_Project_Path): Global variable, replacing Project_Path that was in the body of Prj.Part. (Project_Path): New function (Set_Project_Path): New procedure Initialize Current_Project_Path during elaboration of the package Remove dependency on Prj.Com, no longer needed * prj-ext.ads (Project_Path): New function (Set_Project_Path): New procedure * prj-nmsc.adb (Body_Suffix_Of): New function. Returns . when no suffix is defined for language . (Find_Sources, Record_Other_Sources): Use Body_Suffix_Of, instead of accessing directly the components of Naming. (Look_For_Sources): Use Set (Suffix) to set the suffix of a language. Reorganise of this package. Break procedure Check in several procedures. * prj-nmsc.ads: Replace all procedures (Ada_Check, Other_Languages_Check and Language_Independent_Check) with a single procedure Check. * prj-pars.ads, prj-pars.adb (Parse): Remove parameter Process_Languages, no longer needed. * prj-part.adb (Project_Path): Move to the body of Prj.Ext as Current_Project_Path. Remove elaboration code, moved to the body of Prj.Ext Use new function Prj.Ext.Project_Path instead of old variable Project_Path. (Post_Parse_Context_Clause): Get Resolved_Path as a case-sensitive path. When comparing with project paths on the stack, first put the resolved path in canonical case. (Parse_Single_Project): Set the path name of the project file in the tree to the normalized path. * prj-proc.ads, prj-proc.adb (Check, Recursive_Check, Process): Remove parameter Process_Languages, no longer needed. (Recursive_Check): Call Prj.Nmsc.Check, instead of Ada_Check and Other_Languages_Check. * prj-tree.ads (Project_Name_And_Node): New component Canonical_Path to store the resolved canonical path of the project file. Remove dependency to Prj.Com, no longer needed * prj-util.adb: Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * snames.ads, snames.adb: New standard names: Ada_Roots, Binder_Driver, Compiler_Driver, Compiler_Kind, Compute_Dependency, Default_Linker, Externally_Built, Include_Option, Language_Processing. * makegpr.adb: Numerous changes due to changes in packages Prj and Prj.Nmsc. * gnatls.adb: Add the default project dir (/log/gnat) by default to the project path, except whe "-" is one of the directories in env var ADA_PROJECT_PATH. (Gnatls): In verbose mode, add the new section "Project Search Path:" git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@91877 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/prj.adb | 339 +++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 314 insertions(+), 25 deletions(-) (limited to 'gcc/ada/prj.adb') diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index af6482dac76..602d3a5c550 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -27,6 +27,7 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; with Namet; use Namet; +with Output; use Output; with Osint; use Osint; with Prj.Attr; with Prj.Com; @@ -36,12 +37,15 @@ with Scans; use Scans; with Snames; use Snames; with Uintp; use Uintp; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Case_Util; use GNAT.Case_Util; +with GNAT.OS_Lib; use GNAT.OS_Lib; package body Prj is The_Empty_String : Name_Id; + Name_C_Plus_Plus : Name_Id; + subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; The_Casing_Images : constant array (Known_Casing) of String_Access := @@ -55,15 +59,16 @@ package body Prj is First_Name_Id + Character'Pos ('-'); Std_Naming_Data : Naming_Data := - (Current_Language => No_Name, - Dot_Replacement => Standard_Dot_Replacement, + (Dot_Replacement => Standard_Dot_Replacement, Dot_Repl_Loc => No_Location, Casing => All_Lower_Case, Spec_Suffix => No_Array_Element, - Current_Spec_Suffix => No_Name, + Ada_Spec_Suffix => No_Name, Spec_Suffix_Loc => No_Location, + Impl_Suffixes => No_Impl_Suffixes, + Supp_Suffixes => No_Supp_Language_Index, Body_Suffix => No_Array_Element, - Current_Body_Suffix => No_Name, + Ada_Body_Suffix => No_Name, Body_Suffix_Loc => No_Location, Separate_Suffix => No_Name, Sep_Suffix_Loc => No_Location, @@ -73,8 +78,9 @@ package body Prj is Implementation_Exceptions => No_Array_Element); Project_Empty : constant Project_Data := - (Languages => No_Languages, - Impl_Suffixes => No_Impl_Suffixes, + (Externally_Built => False, + Languages => No_Languages, + Supp_Languages => No_Supp_Language_Index, First_Referred_By => No_Project, Name => No_Name, Path_Name => No_Name, @@ -114,6 +120,10 @@ package body Prj is Extends => No_Project, Extended_By => No_Project, Naming => Std_Naming_Data, + First_Language_Processing => Default_First_Language_Processing_Data, + Supp_Language_Processing => No_Supp_Language_Index, + Default_Linker => No_Name, + Default_Linker_Path => No_Name, Decl => No_Declarations, Imported_Projects => Empty_Project_List, Ada_Include_Path => null, @@ -131,6 +141,18 @@ package body Prj is Depth => 0, Unkept_Comments => False); + ----------------------- + -- Add_Language_Name -- + ----------------------- + + procedure Add_Language_Name (Name : Name_Id) is + begin + Last_Language_Index := Last_Language_Index + 1; + Language_Indexes.Set (Name, Last_Language_Index); + Language_Names.Increment_Last; + Language_Names.Table (Last_Language_Index) := Name; + end Add_Language_Name; + ------------------- -- Add_To_Buffer -- ------------------- @@ -155,6 +177,17 @@ package body Prj is Buffer_Last := Buffer_Last + S'Length; end Add_To_Buffer; + --------------------------- + -- Display_Language_Name -- + --------------------------- + + procedure Display_Language_Name (Language : Language_Index) is + begin + Get_Name_String (Language_Names.Table (Language)); + To_Upper (Name_Buffer (1 .. 1)); + Write_Str (Name_Buffer (1 .. Name_Len)); + end Display_Language_Name; + ------------------- -- Empty_Project -- ------------------- @@ -195,9 +228,12 @@ package body Prj is is procedure Check (Project : Project_Id); - -- Check if a project has already been seen. - -- If not seen, mark it as seen, call Action, - -- and check all its imported projects. + -- Check if a project has already been seen. If not seen, mark it as + -- Seen, Call Action, and check all its imported projects. + + ----------- + -- Check -- + ----------- procedure Check (Project : Project_Id) is List : Project_List; @@ -215,6 +251,8 @@ package body Prj is end if; end Check; + -- Start of procecessing for For_Every_Project_Imported + begin for Project in Projects.First .. Projects.Last loop Projects.Table (Project).Seen := False; @@ -223,6 +261,15 @@ package body Prj is Check (Project => By); end For_Every_Project_Imported; + ---------- + -- Hash -- + ---------- + + function Hash (Name : Name_Id) return Header_Num is + begin + return Hash (Get_Name_String (Name)); + end Hash; + ----------- -- Image -- ----------- @@ -253,18 +300,12 @@ package body Prj is Name_Len := 1; Name_Buffer (1) := '/'; Slash := Name_Find; + Name_Len := 3; + Name_Buffer (1 .. 3) := "c++"; + Name_C_Plus_Plus := Name_Find; - for Lang in Programming_Language loop - Name_Len := Lang_Names (Lang)'Length; - Name_Buffer (1 .. Name_Len) := Lang_Names (Lang).all; - Lang_Name_Ids (Lang) := Name_Find; - Name_Len := Lang_Suffixes (Lang)'Length; - Name_Buffer (1 .. Name_Len) := Lang_Suffixes (Lang).all; - Lang_Suffix_Ids (Lang) := Name_Find; - end loop; - - Std_Naming_Data.Current_Spec_Suffix := Default_Ada_Spec_Suffix; - Std_Naming_Data.Current_Body_Suffix := Default_Ada_Body_Suffix; + Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; + Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix; Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix; Register_Default_Naming_Scheme (Language => Name_Ada, @@ -275,9 +316,91 @@ package body Prj is Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends)); Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External)); + + Language_Indexes.Reset; + Last_Language_Index := No_Language_Index; + Language_Names.Init; + Add_Language_Name (Name_Ada); + Add_Language_Name (Name_C); + Add_Language_Name (Name_C_Plus_Plus); end if; end Initialize; + ---------------- + -- Is_Present -- + ---------------- + + function Is_Present + (Language : Language_Index; + In_Project : Project_Data) return Boolean + is + begin + case Language is + when No_Language_Index => + return False; + + when First_Language_Indexes => + return In_Project.Languages (Language); + + when others => + declare + Supp : Supp_Language; + Supp_Index : Supp_Language_Index := In_Project.Supp_Languages; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Present_Languages.Table (Supp_Index); + + if Supp.Index = Language then + return Supp.Present; + end if; + + Supp_Index := Supp.Next; + end loop; + + return False; + end; + end case; + end Is_Present; + + --------------------------------- + -- Language_Processing_Data_Of -- + --------------------------------- + + function Language_Processing_Data_Of + (Language : Language_Index; + In_Project : Project_Data) return Language_Processing_Data + is + begin + case Language is + when No_Language_Index => + return Default_Language_Processing_Data; + + when First_Language_Indexes => + return In_Project.First_Language_Processing (Language); + + when others => + declare + Supp : Supp_Language_Data; + Supp_Index : Supp_Language_Index := + In_Project.Supp_Language_Processing; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Languages.Table (Supp_Index); + + if Supp.Index = Language then + return Supp.Data; + end if; + + Supp_Index := Supp.Next; + end loop; + + return Default_Language_Processing_Data; + end; + end case; + end Language_Processing_Data_Of; + ------------------------------------ -- Register_Default_Naming_Scheme -- ------------------------------------ @@ -398,17 +521,145 @@ package body Prj is ------------------------ function Same_Naming_Scheme - (Left, Right : Naming_Data) - return Boolean + (Left, Right : Naming_Data) return Boolean is begin return Left.Dot_Replacement = Right.Dot_Replacement and then Left.Casing = Right.Casing - and then Left.Current_Spec_Suffix = Right.Current_Spec_Suffix - and then Left.Current_Body_Suffix = Right.Current_Body_Suffix + and then Left.Ada_Spec_Suffix = Right.Ada_Spec_Suffix + and then Left.Ada_Body_Suffix = Right.Ada_Body_Suffix and then Left.Separate_Suffix = Right.Separate_Suffix; end Same_Naming_Scheme; + --------- + -- Set -- + --------- + + procedure Set + (Language : Language_Index; + Present : Boolean; + In_Project : in out Project_Data) + is + begin + case Language is + when No_Language_Index => + null; + + when First_Language_Indexes => + In_Project.Languages (Language) := Present; + + when others => + declare + Supp : Supp_Language; + Supp_Index : Supp_Language_Index := In_Project.Supp_Languages; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Present_Languages.Table (Supp_Index); + + if Supp.Index = Language then + Present_Languages.Table (Supp_Index).Present := Present; + return; + end if; + + Supp_Index := Supp.Next; + end loop; + + Supp := (Index => Language, Present => Present, + Next => In_Project.Supp_Languages); + Present_Languages.Increment_Last; + Supp_Index := Present_Languages.Last; + Present_Languages.Table (Supp_Index) := Supp; + In_Project.Supp_Languages := Supp_Index; + end; + end case; + end Set; + + procedure Set + (Language_Processing : in Language_Processing_Data; + For_Language : Language_Index; + In_Project : in out Project_Data) + is + begin + case For_Language is + when No_Language_Index => + null; + + when First_Language_Indexes => + In_Project.First_Language_Processing (For_Language) := + Language_Processing; + + when others => + declare + Supp : Supp_Language_Data; + Supp_Index : Supp_Language_Index := + In_Project.Supp_Language_Processing; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Languages.Table (Supp_Index); + + if Supp.Index = For_Language then + Supp_Languages.Table (Supp_Index).Data := + Language_Processing; + return; + end if; + + Supp_Index := Supp.Next; + end loop; + + Supp := (Index => For_Language, Data => Language_Processing, + Next => In_Project.Supp_Language_Processing); + Supp_Languages.Increment_Last; + Supp_Index := Supp_Languages.Last; + Supp_Languages.Table (Supp_Index) := Supp; + In_Project.Supp_Language_Processing := Supp_Index; + end; + end case; + end Set; + + procedure Set + (Suffix : Name_Id; + For_Language : Language_Index; + In_Project : in out Project_Data) + is + begin + case For_Language is + when No_Language_Index => + null; + + when First_Language_Indexes => + In_Project.Naming.Impl_Suffixes (For_Language) := Suffix; + + when others => + declare + Supp : Supp_Suffix; + Supp_Index : Supp_Language_Index := + In_Project.Naming.Supp_Suffixes; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Suffix_Table.Table (Supp_Index); + + if Supp.Index = For_Language then + Supp_Suffix_Table.Table (Supp_Index).Suffix := Suffix; + return; + end if; + + Supp_Index := Supp.Next; + end loop; + + Supp := (Index => For_Language, Suffix => Suffix, + Next => In_Project.Naming.Supp_Suffixes); + Supp_Suffix_Table.Increment_Last; + Supp_Index := Supp_Suffix_Table.Last; + Supp_Suffix_Table.Table (Supp_Index) := Supp; + In_Project.Naming.Supp_Suffixes := Supp_Index; + end; + end case; + end Set; + + -------------------------- -- Standard_Naming_Data -- -------------------------- @@ -419,6 +670,44 @@ package body Prj is return Std_Naming_Data; end Standard_Naming_Data; + --------------- + -- Suffix_Of -- + --------------- + + function Suffix_Of + (Language : Language_Index; + In_Project : Project_Data) return Name_Id + is + begin + case Language is + when No_Language_Index => + return No_Name; + + when First_Language_Indexes => + return In_Project.Naming.Impl_Suffixes (Language); + + when others => + declare + Supp : Supp_Suffix; + Supp_Index : Supp_Language_Index := + In_Project.Naming.Supp_Suffixes; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Suffix_Table.Table (Supp_Index); + + if Supp.Index = Language then + return Supp.Suffix; + end if; + + Supp_Index := Supp.Next; + end loop; + + return No_Name; + end; + end case; + end Suffix_Of; + ----------- -- Value -- ----------- -- cgit v1.2.1