diff options
| -rw-r--r-- | gcc/ada/prj-attr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 315 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 95 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 117 | ||||
| -rw-r--r-- | gcc/ada/prj-util.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/snames.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/snames.ads | 15 |
10 files changed, 327 insertions, 246 deletions
diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index a833de6..41bd6c4 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -127,6 +127,7 @@ package body Prj.Attr is "SVlibrary_auto_init_supported#" & "LVshared_library_minimum_switches#" & "LVlibrary_version_switches#" & + "Saruntime_library_dir#" & -- package Naming diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 1d97d80..f5259b1 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -1333,7 +1333,8 @@ package body Prj.Env is if Src_Data.Language_Name = Language and then (not Src_Data.Locally_Removed) and then - Src_Data.Replaced_By = No_Source + Src_Data.Replaced_By = No_Source and then + Src_Data.Path /= No_Path then if Src_Data.Unit /= No_Name then Get_Name_String (Src_Data.Unit); @@ -1404,6 +1405,7 @@ package body Prj.Env is procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is Disregard : Boolean := True; + pragma Warnings (Off, Disregard); begin for Index in Path_File_Table.First .. diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 0e9641a..37c8fc1 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -217,7 +217,7 @@ package body Prj.Ext is Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; -- After removing the '-', go back one character to get the next - -- directory corectly. + -- directory correctly. Last := Last - 1; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 67d3975..0574cb2 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -668,6 +668,48 @@ package body Prj.Nmsc is Need_Letter : Boolean := True; Last_Underscore : Boolean := False; OK : Boolean := The_Name'Length > 0; + First : Positive; + + function Is_Reserved (S : String) return Boolean; + -- Check that the given name is not an Ada 95 reserved word. The + -- reason for the Ada 95 here is that we do not want to exclude the case + -- of an Ada 95 unit called Interface (for example). In Ada 2005, such + -- a unit name would be rejected anyway by the compiler, so there is no + -- requirement that the project file parser reject this. + + ----------------- + -- Is_Reserved -- + ----------------- + + function Is_Reserved (S : String) return Boolean is + Name : Name_Id; + + begin + Name_Len := 0; + Add_Str_To_Name_Buffer (S); + Name := Name_Find; + + if Get_Name_Table_Byte (Name) /= 0 + and then Name /= Name_Project + and then Name /= Name_Extends + and then Name /= Name_External + and then Name not in Ada_2005_Reserved_Words + then + Unit := No_Name; + + if Current_Verbosity = High then + Write_Str (The_Name); + Write_Line (" is an Ada reserved word."); + end if; + + return True; + + else + return False; + end if; + end Is_Reserved; + + -- Start of processing for Check_Ada_Name begin To_Lower (The_Name); @@ -677,11 +719,14 @@ package body Prj.Nmsc is -- Special cases of children of packages A, G, I and S on VMS - if OpenVMS_On_Target and then - Name_Len > 3 and then - Name_Buffer (2 .. 3) = "__" and then - ((Name_Buffer (1) = 'a') or else (Name_Buffer (1) = 'g') or else - (Name_Buffer (1) = 'i') or else (Name_Buffer (1) = 's')) + if OpenVMS_On_Target + and then Name_Len > 3 + and then Name_Buffer (2 .. 3) = "__" + and then + ((Name_Buffer (1) = 'a') or else + (Name_Buffer (1) = 'g') or else + (Name_Buffer (1) = 'i') or else + (Name_Buffer (1) = 's')) then Name_Buffer (2) := '.'; Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len); @@ -690,28 +735,12 @@ package body Prj.Nmsc is Real_Name := Name_Find; - -- Check first that the given name is not an Ada 95 reserved word. The - -- reason for the Ada 95 here is that we do not want to exclude the case - -- of an Ada 95 unit called Interface (for example). In Ada 2005, such - -- a unit name would be rejected anyway by the compiler, so there is no - -- requirement that the project file parser reject this. - - if Get_Name_Table_Byte (Real_Name) /= 0 - and then Real_Name /= Name_Project - and then Real_Name /= Name_Extends - and then Real_Name /= Name_External - and then Real_Name not in Ada_2005_Reserved_Words - then - Unit := No_Name; - - if Current_Verbosity = High then - Write_Str (The_Name); - Write_Line (" is an Ada reserved word."); - end if; - + if Is_Reserved (Name_Buffer (1 .. Name_Len)) then return; end if; + First := The_Name'First; + for Index in The_Name'Range loop if Need_Letter then @@ -753,6 +782,13 @@ package body Prj.Nmsc is elsif The_Name (Index) = '.' then + -- First, check if the name before the dot is not a reserved word + if Is_Reserved (The_Name (First .. Index - 1)) then + return; + end if; + + First := Index + 1; + -- We need a letter after a dot Need_Letter := True; @@ -785,6 +821,12 @@ package body Prj.Nmsc is OK := OK and then not Need_Letter and then not Last_Underscore; if OK then + if First /= Name'First and then + Is_Reserved (The_Name (First .. The_Name'Last)) + then + return; + end if; + Unit := Real_Name; else @@ -824,6 +866,7 @@ package body Prj.Nmsc is begin -- Dot_Replacement cannot + -- - be empty -- - start or end with an alphanumeric -- - be a single '_' @@ -1927,6 +1970,14 @@ package body Prj.Nmsc is (Lang_Index).Config.Toolchain_Version := Element.Value.Value; + when Name_Runtime_Library_Dir => + + -- Attribute Runtime_Library_Dir (<language>) + + In_Tree.Languages_Data.Table + (Lang_Index).Config.Runtime_Library_Dir := + Element.Value.Value; + when others => null; end case; @@ -1941,9 +1992,7 @@ package body Prj.Nmsc is begin Process_Project_Level_Simple_Attributes; - Process_Project_Level_Array_Attributes; - Process_Packages; -- For unit based languages, set Casing, Dot_Replacement and @@ -3169,12 +3218,11 @@ package body Prj.Nmsc is -- For all unit based languages, if any, set the specified -- value of Dot_Replacement, Casing and/or Separate_Suffix. - if Dot_Replacement /= No_File or else - Casing_Defined or else - Separate_Suffix /= No_File + if Dot_Replacement /= No_File + or else Casing_Defined + or else Separate_Suffix /= No_File then Lang_Id := Data.First_Language_Processing; - while Lang_Id /= No_Language_Index loop if In_Tree.Languages_Data.Table (Lang_Id).Config.Kind = Unit_Based @@ -3206,11 +3254,12 @@ package body Prj.Nmsc is -- Next, get the spec and body suffixes declare - Suffix : Variable_Value; - - Lang_Id : Language_Index := Data.First_Language_Processing; + Suffix : Variable_Value; + Lang_Id : Language_Index; Lang : Name_Id; + begin + Lang_Id := Data.First_Language_Processing; while Lang_Id /= No_Language_Index loop Lang := In_Tree.Languages_Data.Table (Lang_Id).Name; @@ -3384,18 +3433,20 @@ package body Prj.Nmsc is end if; end Check_Library; + -- Start of processing for Check_Library_Attributes + begin -- Special case of extending project if Data.Extends /= No_Project then declare Extended_Data : constant Project_Data := - In_Tree.Projects.Table (Data.Extends); + In_Tree.Projects.Table (Data.Extends); begin - -- If the project extended is a library project, we inherit - -- the library name, if it is not redefined; we check that - -- the library directory is specified. + -- If the project extended is a library project, we inherit the + -- library name, if it is not redefined; we check that the library + -- directory is specified. if Extended_Data.Library then if Lib_Name.Default then @@ -3606,7 +3657,7 @@ package body Prj.Nmsc is else if Lib_ALI_Dir.Value = Empty_String then if Current_Verbosity = High then - Write_Line ("No library 'A'L'I directory specified"); + Write_Line ("No library ALI directory specified"); end if; Data.Library_ALI_Dir := Data.Library_Dir; Data.Display_Library_ALI_Dir := Data.Display_Library_Dir; @@ -3946,10 +3997,11 @@ package body Prj.Nmsc is end; declare - Current : Array_Element_Id := Data.Naming.Spec_Suffix; + Current : Array_Element_Id; Element : Array_Element; begin + Current := Data.Naming.Spec_Suffix; while Current /= No_Array_Element loop Element := In_Tree.Array_Elements.Table (Current); Get_Name_String (Element.Value.Value); @@ -3970,14 +4022,14 @@ package body Prj.Nmsc is declare Impl_Suffixs : Array_Element_Id := - Util.Value_Of - (Name_Body_Suffix, - Naming.Decl.Arrays, - In_Tree); + Util.Value_Of + (Name_Body_Suffix, + Naming.Decl.Arrays, + In_Tree); - Suffix : Array_Element_Id; - Element : Array_Element; - Suffix2 : Array_Element_Id; + Suffix : Array_Element_Id; + Element : Array_Element; + Suffix2 : Array_Element_Id; begin -- If some suffixes have been specified, we make sure that @@ -3987,12 +4039,11 @@ package body Prj.Nmsc is if Impl_Suffixs /= No_Array_Element then Suffix := Data.Naming.Body_Suffix; - while Suffix /= No_Array_Element loop Element := In_Tree.Array_Elements.Table (Suffix); - Suffix2 := Impl_Suffixs; + Suffix2 := Impl_Suffixs; while Suffix2 /= No_Array_Element loop exit when In_Tree.Array_Elements.Table (Suffix2).Index = Element.Index; @@ -4001,8 +4052,7 @@ package body Prj.Nmsc is end loop; -- There is a registered default suffix, but no suffix was - -- specified in the project file. Add the default to the - -- array. + -- specified in the project file. Add default to the array. if Suffix2 = No_Array_Element then Array_Element_Table.Increment_Last @@ -4029,10 +4079,11 @@ package body Prj.Nmsc is end; declare - Current : Array_Element_Id := Data.Naming.Body_Suffix; + Current : Array_Element_Id; Element : Array_Element; begin + Current := Data.Naming.Body_Suffix; while Current /= No_Array_Element loop Element := In_Tree.Array_Elements.Table (Current); Get_Name_String (Element.Value.Value); @@ -4070,12 +4121,12 @@ package body Prj.Nmsc is --------------------------------- procedure Check_Programming_Languages - (In_Tree : Project_Tree_Ref; - Project : Project_Id; - Data : in out Project_Data) + (In_Tree : Project_Tree_Ref; + Project : Project_Id; + Data : in out Project_Data) is - Languages : Variable_Value := Nil_Variable_Value; - Def_Lang : Variable_Value := Nil_Variable_Value; + Languages : Variable_Value := Nil_Variable_Value; + Def_Lang : Variable_Value := Nil_Variable_Value; Def_Lang_Id : Name_Id; begin @@ -4170,6 +4221,7 @@ package body Prj.Nmsc is begin if Get_Mode = Ada_Only then + -- Assume that there is no language specified yet Data.Other_Sources_Present := False; @@ -4356,16 +4408,13 @@ package body Prj.Nmsc is In_Tree); Auto_Init_Supported : Boolean; - OK : Boolean := True; - Source : Source_Id; Next_Proj : Project_Id; begin if Get_Mode = Multi_Language then Auto_Init_Supported := Data.Config.Auto_Init_Supported; - else Auto_Init_Supported := MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported; @@ -4397,8 +4446,9 @@ package body Prj.Nmsc is declare ALI : constant String := - ALI_File_Name (Name_Buffer (1 .. Name_Len)); + ALI_File_Name (Name_Buffer (1 .. Name_Len)); ALI_Name_Id : Name_Id; + begin Name_Len := ALI'Length; Name_Buffer (1 .. Name_Len) := ALI; @@ -4650,8 +4700,8 @@ package body Prj.Nmsc is if Lib_Auto_Init.Default then - -- If no attribute Library_Auto_Init is declared, then - -- set auto init only if it is supported. + -- If no attribute Library_Auto_Init is declared, then set auto + -- init only if it is supported. Data.Lib_Auto_Init := Auto_Init_Supported; @@ -4667,8 +4717,8 @@ package body Prj.Nmsc is Data.Lib_Auto_Init := True; else - -- Library_Auto_Init cannot be "true" if auto init - -- is not supported + -- Library_Auto_Init cannot be "true" if auto init is not + -- supported Error_Msg (Project, In_Tree, @@ -4686,12 +4736,11 @@ package body Prj.Nmsc is end if; end SAL_Library; - -- If attribute Library_Src_Dir is defined and not the - -- empty string, check if the directory exist and is not - -- the object directory or one of the source directories. - -- This is the directory where copies of the interface - -- sources will be copied. Note that this directory may be - -- the library directory. + -- If attribute Library_Src_Dir is defined and not the empty string, + -- check if the directory exist and is not the object directory or + -- one of the source directories. This is the directory where copies + -- of the interface sources will be copied. Note that this directory + -- may be the library directory. if Lib_Src_Dir.Value /= Empty_String then declare @@ -4713,12 +4762,12 @@ package body Prj.Nmsc is if Data.Library_Src_Dir = No_Path then - -- Get the absolute name of the library directory - -- that does not exist, to report an error. + -- Get the absolute name of the library directory that does + -- not exist, to report an error. declare Dir_Name : constant String := - Get_Name_String (Dir_Id); + Get_Name_String (Dir_Id); begin if Is_Absolute_Path (Dir_Name) then @@ -4751,8 +4800,7 @@ package body Prj.Nmsc is Lib_Src_Dir.Location); end; - -- Report an error if it is the same as the object - -- directory. + -- Report error if it is the same as the object directory elsif Data.Library_Src_Dir = Data.Object_Directory then Error_Msg @@ -4773,8 +4821,7 @@ package body Prj.Nmsc is Src_Dirs := Data.Source_Dirs; while Src_Dirs /= Nil_String loop - Src_Dir := In_Tree.String_Elements.Table - (Src_Dirs); + Src_Dir := In_Tree.String_Elements.Table (Src_Dirs); -- Report error if it is one of the source directories @@ -5105,6 +5152,7 @@ package body Prj.Nmsc is procedure Add_File is File : File_Name_Type; + begin Add ('"'); File_Number := File_Number + 1; @@ -5131,6 +5179,7 @@ package body Prj.Nmsc is procedure Add_Name is Name : Name_Id; + begin Add ('"'); Name_Number := Name_Number + 1; @@ -5171,7 +5220,7 @@ package body Prj.Nmsc is First := First + 1; -- Warning character is always the first one in this package - -- this is an undocumented kludge!!! + -- this is an undocumented kludge??? elsif Msg (First) = '?' then First := First + 1; @@ -5248,7 +5297,7 @@ package body Prj.Nmsc is Write_Line (Source_Directory); end if; - -- We look to every entry in the source directory + -- We look at every entry in the source directory Open (Dir, Source_Directory (Source_Directory'First .. Dir_Last)); @@ -5318,10 +5367,9 @@ package body Prj.Nmsc is Write_Line ("end Looking for sources."); end if; - -- If we have looked for sources and found none, then - -- it is an error, except if it is an extending project. - -- If a non extending project is not supposed to contain - -- any source, then we never call Find_Ada_Sources. + -- If we have looked for sources and found none, then it is an error, + -- except if it is an extending project. If a non extending project is + -- not supposed to contain any source, then never call Find_Ada_Sources. if Current_Source = Nil_String and then Data.Extends = No_Project @@ -5341,7 +5389,7 @@ package body Prj.Nmsc is For_Language : Language_Index; Follow_Links : Boolean := False) is - Source_Dir : String_List_Id := Data.Source_Dirs; + Source_Dir : String_List_Id; Element : String_Element; Dir : Dir_Type; Current_Source : String_List_Id := Nil_String; @@ -5352,8 +5400,9 @@ package body Prj.Nmsc is Write_Line ("Looking for sources:"); end if; - -- For each subdirectory + -- Loop through subdirectories + Source_Dir := Data.Source_Dirs; while Source_Dir /= Nil_String loop begin Source_Recorded := False; @@ -5367,8 +5416,8 @@ package body Prj.Nmsc is Name_Buffer (1 .. Name_Len) & Directory_Separator; - Dir_Last : constant Natural := - Compute_Directory_Last (Source_Directory); + Dir_Last : constant Natural := + Compute_Directory_Last (Source_Directory); begin if Current_Verbosity = High then @@ -5464,10 +5513,10 @@ package body Prj.Nmsc is if For_Language = Ada_Language_Index then - -- If we have looked for sources and found none, then - -- it is an error, except if it is an extending project. - -- If a non extending project is not supposed to contain - -- any source, then we never call Find_Sources. + -- If we have looked for sources and found none, then it is an error, + -- except if it is an extending project. If a non extending project + -- is not supposed to contain any source files, then never call + -- Find_Sources. if Current_Source /= Nil_String then Data.Ada_Sources_Present := True; @@ -5502,9 +5551,9 @@ package body Prj.Nmsc is Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes, In_Tree); - Exec_Dir : constant Variable_Value := - Util.Value_Of - (Name_Exec_Dir, Data.Decl.Attributes, In_Tree); + Exec_Dir : constant Variable_Value := + Util.Value_Of + (Name_Exec_Dir, Data.Decl.Attributes, In_Tree); Source_Dirs : constant Variable_Value := Util.Value_Of @@ -5527,8 +5576,7 @@ package body Prj.Nmsc is Location : Source_Ptr; Removed : Boolean := False); -- Find one or several source directories, and add (or remove, if - -- Removed is True) them to the list of source directories of the - -- project. + -- Removed is True) them to list of source directories of the project. ---------------------- -- Find_Source_Dirs -- @@ -5551,13 +5599,13 @@ package body Prj.Nmsc is ------------------------- procedure Recursive_Find_Dirs (Path : Name_Id) is - Dir : Dir_Type; - Name : String (1 .. 250); - Last : Natural; - List : String_List_Id := Data.Source_Dirs; - Prev : String_List_Id := Nil_String; - Element : String_Element; - Found : Boolean := False; + Dir : Dir_Type; + Name : String (1 .. 250); + Last : Natural; + List : String_List_Id; + Prev : String_List_Id; + Element : String_Element; + Found : Boolean := False; Non_Canonical_Path : Name_Id := No_Name; Canonical_Path : Name_Id := No_Name; @@ -5579,9 +5627,9 @@ package body Prj.Nmsc is Canonical_Path := Name_Find; -- To avoid processing the same directory several times, check - -- if the directory is already in Recursive_Dirs. If it is, - -- then there is nothing to do, just return. If it is not, put - -- it there and continue recursive processing. + -- if the directory is already in Recursive_Dirs. If it is, then + -- there is nothing to do, just return. If it is not, put it there + -- and continue recursive processing. if not Removed then if Recursive_Dirs.Get (Canonical_Path) then @@ -5593,6 +5641,8 @@ package body Prj.Nmsc is -- Check if directory is already in list + List := Data.Source_Dirs; + Prev := Nil_String; while List /= Nil_String loop Element := In_Tree.String_Elements.Table (List); @@ -7564,9 +7614,26 @@ package body Prj.Nmsc is end if; end Search_Directories; + Excluded_Sources : Variable_Value := + Util.Value_Of + (Name_Excluded_Source_Files, + Data.Decl.Attributes, + In_Tree); + -- Start of processing for Look_For_Sources begin + -- If Excluded_Source_Files is not declared, check + -- Locally_Removed_Files. + + if Excluded_Sources.Default then + Excluded_Sources := + Util.Value_Of + (Name_Locally_Removed_Files, + Data.Decl.Attributes, + In_Tree); + end if; + if Get_Mode = Ada_Only and then Is_A_Language (In_Tree, Data, "ada") then @@ -7583,12 +7650,6 @@ package body Prj.Nmsc is Data.Decl.Attributes, In_Tree); - Excluded_Sources : Variable_Value := - Util.Value_Of - (Name_Excluded_Source_Files, - Data.Decl.Attributes, - In_Tree); - begin pragma Assert (Sources.Kind = List, @@ -7708,17 +7769,6 @@ package body Prj.Nmsc is (Project, In_Tree, Data, Follow_Links); end if; - -- If Excluded_ource_Files is not declared, check - -- Locally_Removed_Files. - - if Excluded_Sources.Default then - Excluded_Sources := - Util.Value_Of - (Name_Locally_Removed_Files, - Data.Decl.Attributes, - In_Tree); - end if; - -- If there are sources that are locally removed, mark them as -- such in the Units table. @@ -8120,25 +8170,9 @@ package body Prj.Nmsc is Data.Decl.Attributes, In_Tree); - Excluded_Sources : Variable_Value := - Util.Value_Of - (Name_Excluded_Source_Files, - Data.Decl.Attributes, - In_Tree); Name_Loc : Name_Location; begin - -- If Excluded_ource_Files is not declared, check - -- Locally_Removed_Files. - - if Excluded_Sources.Default then - Excluded_Sources := - Util.Value_Of - (Name_Locally_Removed_Files, - Data.Decl.Attributes, - In_Tree); - end if; - if not Sources.Default then if not Source_List_File.Default then Error_Msg @@ -8314,8 +8348,7 @@ package body Prj.Nmsc is function Path_Name_Of (File_Name : File_Name_Type; - Directory : Path_Name_Type) - return String + Directory : Path_Name_Type) return String is Result : String_Access; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 2fa0973..f576841 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -439,7 +439,9 @@ package body Prj.Part is Store_Comments : Boolean := False) is Current_Directory : constant String := Get_Current_Dir; + Dummy : Boolean; + pragma Warnings (Off, Dummy); Real_Project_File_Name : String_Access := Osint.To_Canonical_File_Spec @@ -1055,16 +1057,8 @@ package body Prj.Part is -- or not following Ada identifier's syntax). Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name); - - if In_Configuration then - Error_Msg ("{ is not a valid path name for a configuration " & - "project file", - Token_Ptr); - - else - Error_Msg ("?{ is not a valid path name for a project file", - Token_Ptr); - end if; + Error_Msg ("?{ is not a valid path name for a project file", + Token_Ptr); end if; if Current_Verbosity >= Medium then @@ -1234,49 +1228,52 @@ package body Prj.Part is Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); end; - declare - Name_And_Node : Tree_Private_Part.Project_Name_And_Node := - Tree_Private_Part.Projects_Htable.Get_First - (In_Tree.Projects_HT); - Project_Name : Name_Id := Name_And_Node.Name; - - begin - -- Check if we already have a project with this name - - while Project_Name /= No_Name - and then Project_Name /= Name_Of_Project - loop - Name_And_Node := - Tree_Private_Part.Projects_Htable.Get_Next + if not In_Configuration then + declare + Name_And_Node : Tree_Private_Part.Project_Name_And_Node := + Tree_Private_Part.Projects_Htable.Get_First (In_Tree.Projects_HT); - Project_Name := Name_And_Node.Name; - end loop; + Project_Name : Name_Id := Name_And_Node.Name; - -- Report an error if we already have a project with this name + begin + -- Check if we already have a project with this name + + while Project_Name /= No_Name + and then Project_Name /= Name_Of_Project + loop + Name_And_Node := + Tree_Private_Part.Projects_Htable.Get_Next + (In_Tree.Projects_HT); + Project_Name := Name_And_Node.Name; + end loop; - if Project_Name /= No_Name then - Error_Msg_Name_1 := Project_Name; - Error_Msg - ("duplicate project name %%", Location_Of (Project, In_Tree)); - Error_Msg_Name_1 := - Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree)); - Error_Msg - ("\already in %%", Location_Of (Project, In_Tree)); + -- Report an error if we already have a project with this name - 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; + if Project_Name /= No_Name then + Error_Msg_Name_1 := Project_Name; + Error_Msg + ("duplicate project name %%", + Location_Of (Project, In_Tree)); + Error_Msg_Name_1 := + 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; end if; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index f6a1610..c3c321c 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -766,6 +766,7 @@ 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; + Lower : Boolean; begin if The_Package /= No_Package then @@ -792,9 +793,26 @@ package body Prj.Proc is Get_Name_String (Index); - if Case_Insensitive - (The_Current_Term, From_Project_Node_Tree) - then + Lower := + Case_Insensitive + (The_Current_Term, From_Project_Node_Tree); + + -- In multi-language mode (gprbuild), the index is + -- always case insensitive if it does not include + -- any dot. + + if Get_Mode = Multi_Language and then not Lower then + Lower := True; + + for J in 1 .. Name_Len loop + if Name_Buffer (J) = '.' then + Lower := False; + exit; + end if; + end loop; + end if; + + if Lower then To_Lower (Name_Buffer (1 .. Name_Len)); end if; @@ -1875,12 +1893,32 @@ package body Prj.Proc is -- Put in lower case, if necessary - if Case_Insensitive - (Current_Item, From_Project_Node_Tree) - then - GNAT.Case_Util.To_Lower - (Name_Buffer (1 .. Name_Len)); - end if; + declare + Lower : Boolean; + + begin + Lower := + Case_Insensitive + (Current_Item, From_Project_Node_Tree); + + -- In multi-language mode (gprbuild), the index is + -- always case insensitive if it does not include + -- any dot. + + if Get_Mode = Multi_Language and then not Lower then + for J in 1 .. Name_Len loop + if Name_Buffer (J) = '.' then + Lower := False; + exit; + end if; + end loop; + end if; + + if Lower then + GNAT.Case_Util.To_Lower + (Name_Buffer (1 .. Name_Len)); + end if; + end; declare The_Array : Array_Id; @@ -1895,18 +1933,19 @@ package body Prj.Proc is -- Look for the array in the appropriate list if Pkg /= No_Package then - The_Array := In_Tree.Packages.Table - (Pkg).Decl.Arrays; + The_Array := + In_Tree.Packages.Table (Pkg).Decl.Arrays; else - The_Array := In_Tree.Projects.Table - (Project).Decl.Arrays; + The_Array := + In_Tree.Projects.Table (Project).Decl.Arrays; end if; while The_Array /= No_Array - and then In_Tree.Arrays.Table - (The_Array).Name /= Current_Item_Name + and then + In_Tree.Arrays.Table (The_Array).Name /= + Current_Item_Name loop The_Array := In_Tree.Arrays.Table (The_Array).Next; @@ -1918,27 +1957,22 @@ package body Prj.Proc is -- created automatically later if The_Array = No_Array then - Array_Table.Increment_Last - (In_Tree.Arrays); - The_Array := Array_Table.Last - (In_Tree.Arrays); + Array_Table.Increment_Last (In_Tree.Arrays); + The_Array := Array_Table.Last (In_Tree.Arrays); if Pkg /= No_Package then - In_Tree.Arrays.Table - (The_Array) := + In_Tree.Arrays.Table (The_Array) := (Name => Current_Item_Name, Value => No_Array_Element, Next => In_Tree.Packages.Table (Pkg).Decl.Arrays); - In_Tree.Packages.Table - (Pkg).Decl.Arrays := + In_Tree.Packages.Table (Pkg).Decl.Arrays := The_Array; else - In_Tree.Arrays.Table - (The_Array) := + In_Tree.Arrays.Table (The_Array) := (Name => Current_Item_Name, Value => No_Array_Element, Next => @@ -1946,8 +1980,7 @@ package body Prj.Proc is (Project).Decl.Arrays); In_Tree.Projects.Table - (Project).Decl.Arrays := - The_Array; + (Project).Decl.Arrays := The_Array; end if; -- Otherwise initialize The_Array_Element as the @@ -1955,8 +1988,7 @@ package body Prj.Proc is else The_Array_Element := - In_Tree.Arrays.Table - (The_Array).Value; + In_Tree.Arrays.Table (The_Array).Value; end if; -- Look in the list, if any, to find an element @@ -1984,16 +2016,16 @@ package body Prj.Proc is In_Tree.Array_Elements.Table (The_Array_Element) := - (Index => Index_Name, - Src_Index => - Source_Index_Of - (Current_Item, From_Project_Node_Tree), - Index_Case_Sensitive => - not Case_Insensitive - (Current_Item, From_Project_Node_Tree), - Value => New_Value, - Next => In_Tree.Arrays.Table - (The_Array).Value); + (Index => Index_Name, + Src_Index => + Source_Index_Of + (Current_Item, From_Project_Node_Tree), + Index_Case_Sensitive => + not Case_Insensitive + (Current_Item, From_Project_Node_Tree), + Value => New_Value, + Next => In_Tree.Arrays.Table + (The_Array).Value); In_Tree.Arrays.Table (The_Array).Value := The_Array_Element; @@ -2038,7 +2070,7 @@ package body Prj.Proc is Name : Name_Id := No_Name; begin - -- If a project were specified for the case variable, + -- If a project was specified for the case variable, -- get its id. if Project_Node_Of @@ -2223,7 +2255,6 @@ package body Prj.Proc is is begin Error_Report := Report_Error; - Success := True; if Reset_Tree then @@ -2244,6 +2275,10 @@ package body Prj.Proc is From_Project_Node_Tree => From_Project_Node_Tree, Extended_By => No_Project); + Success := + Total_Errors_Detected = 0 + and then + (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); end Process_Project_Tree_Phase_1; ---------------------------------- diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 1917bd2..c41c3da 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -524,9 +524,10 @@ package body Prj.Util is In_Tree : Project_Tree_Ref; Force_Lower_Case_Index : Boolean := False) return Variable_Value is - Current : Array_Element_Id; - Element : Array_Element; - Real_Index : Name_Id; + Current : Array_Element_Id; + Element : Array_Element; + Real_Index_1 : Name_Id; + Real_Index_2 : Name_Id; begin Current := In_Array; @@ -537,18 +538,25 @@ package body Prj.Util is Element := In_Tree.Array_Elements.Table (Current); - Real_Index := Index; + Real_Index_1 := Index; if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then Get_Name_String (Index); To_Lower (Name_Buffer (1 .. Name_Len)); - Real_Index := Name_Find; + Real_Index_1 := Name_Find; end if; while Current /= No_Array_Element loop Element := In_Tree.Array_Elements.Table (Current); + Real_Index_2 := Element.Index; + + if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then + Get_Name_String (Element.Index); + To_Lower (Name_Buffer (1 .. Name_Len)); + Real_Index_2 := Name_Find; + end if; - if Real_Index = Element.Index and then + if Real_Index_1 = Real_Index_2 and then Src_Index = Element.Src_Index then return Element.Value; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index c0c936e..938b3a0 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -370,6 +370,8 @@ package Prj is -- shared libraries. Specified in the configuration. When not specified, -- there is no need for such switch. + Runtime_Library_Dir : Name_Id := No_Name; + Mapping_File_Switches : Name_List_Index := No_Name_List; -- The option(s) to provide a mapping file to the compiler. Specified in -- the configuration. When not ??? @@ -417,6 +419,7 @@ package Prj is Compiler_Driver_Path => null, Compiler_Required_Switches => No_Name_List, Compilation_PIC_Option => No_Name_List, + Runtime_Library_Dir => No_Name, Mapping_File_Switches => No_Name_List, Mapping_Spec_Suffix => No_File, Mapping_Body_Suffix => No_File, diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index fb456ac..a6693a7 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -776,6 +776,7 @@ package body Snames is "symbolic_link_supported#" & "toolchain_description#" & "toolchain_version#" & + "runtime_library_dir#" & "unaligned_valid#" & "interface#" & "overriding#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 2b78213..b7a7ab1 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -1092,25 +1092,26 @@ package Snames is Name_Symbolic_Link_Supported : constant Name_Id := N + 715; Name_Toolchain_Description : constant Name_Id := N + 716; Name_Toolchain_Version : constant Name_Id := N + 717; + Name_Runtime_Library_Dir : constant Name_Id := N + 718; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 718; + Name_Unaligned_Valid : constant Name_Id := N + 719; -- Ada 2005 reserved words - First_2005_Reserved_Word : constant Name_Id := N + 719; - Name_Interface : constant Name_Id := N + 719; - Name_Overriding : constant Name_Id := N + 720; - Name_Synchronized : constant Name_Id := N + 721; - Last_2005_Reserved_Word : constant Name_Id := N + 721; + First_2005_Reserved_Word : constant Name_Id := N + 720; + Name_Interface : constant Name_Id := N + 720; + Name_Overriding : constant Name_Id := N + 721; + Name_Synchronized : constant Name_Id := N + 722; + Last_2005_Reserved_Word : constant Name_Id := N + 722; 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 + 721; + Last_Predefined_Name : constant Name_Id := N + 722; --------------------------------------- -- Subtypes Defining Name Categories -- |