Skip to content

R
riscv-gcc-1
Commit 1b685674 by Vincent Celier Committed by Arnaud Charlet
Options

snames.adb, snames.ads: Add new standard name runtime_library_dir 

2007-10-15  Vincent Celier  <celier@adacore.com>

	* snames.adb, snames.ads: Add new standard name runtime_library_dir

	* prj.ads (Language_Config): Add new component Runtime_Library_Dir

	* prj-attr.adb: Add project level attribute Runtime_Library_Dir

	* prj-env.adb (Create_Mapping_File): Do not put an entry if the path of
	the source is unknown.

	* prj-ext.adb: Spelling error fix

	* prj-nmsc.adb (Check_Ada_Name): Reject any unit that includes an Ada
	95 reserved word in its name.
	(Process_Project_Level_Array_Attributes): Process new attribute
	Runtime_Library_Dir.

	* prj-part.adb (Parse_Single_Project): Do not check the name of the
	config project against the user project names.

	* prj-proc.adb (Expression): In multi-language mode, indexes that do
	not include a dot are always case insensitive.
	(Process_Declarative_Items): Ditto
	(Process_Project_Tree_Phase_1): Set Success to False in case an error is
	detected.

	* prj-util.adb (Value_Of (In_Array)): When Force_Lower_Case_Index is
	True, compare both indexes in lower case.

From-SVN: r129329
parent c16dd6a8
Showing with 249 additions and 168 deletions
gcc/ada/prj-attr.adb
...@@ -127,6 +127,7 @@ package body Prj.Attr is ...@@ -127,6 +127,7 @@ package body Prj.Attr is
"SVlibrary_auto_init_supported#" & "SVlibrary_auto_init_supported#" &
"LVshared_library_minimum_switches#" & "LVshared_library_minimum_switches#" &
"LVlibrary_version_switches#" & "LVlibrary_version_switches#" &
"Saruntime_library_dir#" &
-- package Naming -- package Naming
......
gcc/ada/prj-env.adb
...@@ -1333,7 +1333,8 @@ package body Prj.Env is ...@@ -1333,7 +1333,8 @@ package body Prj.Env is
if Src_Data.Language_Name = Language and then if Src_Data.Language_Name = Language and then
(not Src_Data.Locally_Removed) 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 then
if Src_Data.Unit /= No_Name then if Src_Data.Unit /= No_Name then
Get_Name_String (Src_Data.Unit); Get_Name_String (Src_Data.Unit);
...@@ -1404,6 +1405,7 @@ package body Prj.Env is ...@@ -1404,6 +1405,7 @@ package body Prj.Env is
procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is
Disregard : Boolean := True; Disregard : Boolean := True;
pragma Warnings (Off, Disregard);
begin begin
for Index in Path_File_Table.First .. for Index in Path_File_Table.First ..
......
gcc/ada/prj-ext.adb
...@@ -217,7 +217,7 @@ package body Prj.Ext is ...@@ -217,7 +217,7 @@ package body Prj.Ext is
Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
-- After removing the '-', go back one character to get the next -- After removing the '-', go back one character to get the next
-- directory corectly. -- directory correctly.
Last := Last - 1; Last := Last - 1;
......
gcc/ada/prj-nmsc.adb
...@@ -668,6 +668,48 @@ package body Prj.Nmsc is ...@@ -668,6 +668,48 @@ package body Prj.Nmsc is
Need_Letter : Boolean := True; Need_Letter : Boolean := True;
Last_Underscore : Boolean := False; Last_Underscore : Boolean := False;
OK : Boolean := The_Name'Length > 0; 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 begin
To_Lower (The_Name); To_Lower (The_Name);
...@@ -677,11 +719,14 @@ package body Prj.Nmsc is ...@@ -677,11 +719,14 @@ package body Prj.Nmsc is
-- Special cases of children of packages A, G, I and S on VMS -- Special cases of children of packages A, G, I and S on VMS
if OpenVMS_On_Target and then if OpenVMS_On_Target
Name_Len > 3 and then and then Name_Len > 3
Name_Buffer (2 .. 3) = "__" and then and then Name_Buffer (2 .. 3) = "__"
((Name_Buffer (1) = 'a') or else (Name_Buffer (1) = 'g') or else and then
(Name_Buffer (1) = 'i') or else (Name_Buffer (1) = 's')) ((Name_Buffer (1) = 'a') or else
(Name_Buffer (1) = 'g') or else
(Name_Buffer (1) = 'i') or else
(Name_Buffer (1) = 's'))
then then
Name_Buffer (2) := '.'; Name_Buffer (2) := '.';
Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len); Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
...@@ -690,28 +735,12 @@ package body Prj.Nmsc is ...@@ -690,28 +735,12 @@ package body Prj.Nmsc is
Real_Name := Name_Find; Real_Name := Name_Find;
-- Check first that the given name is not an Ada 95 reserved word. The if Is_Reserved (Name_Buffer (1 .. Name_Len)) then
-- 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;
return; return;
end if; end if;
First := The_Name'First;
for Index in The_Name'Range loop for Index in The_Name'Range loop
if Need_Letter then if Need_Letter then
...@@ -753,6 +782,13 @@ package body Prj.Nmsc is ...@@ -753,6 +782,13 @@ package body Prj.Nmsc is
elsif The_Name (Index) = '.' then 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 -- We need a letter after a dot
Need_Letter := True; Need_Letter := True;
...@@ -785,6 +821,12 @@ package body Prj.Nmsc is ...@@ -785,6 +821,12 @@ package body Prj.Nmsc is
OK := OK and then not Need_Letter and then not Last_Underscore; OK := OK and then not Need_Letter and then not Last_Underscore;
if OK then if OK then
if First /= Name'First and then
Is_Reserved (The_Name (First .. The_Name'Last))
then
return;
end if;
Unit := Real_Name; Unit := Real_Name;
else else
...@@ -824,6 +866,7 @@ package body Prj.Nmsc is ...@@ -824,6 +866,7 @@ package body Prj.Nmsc is
begin begin
-- Dot_Replacement cannot -- Dot_Replacement cannot
-- - be empty -- - be empty
-- - start or end with an alphanumeric -- - start or end with an alphanumeric
-- - be a single '_' -- - be a single '_'
...@@ -1927,6 +1970,14 @@ package body Prj.Nmsc is ...@@ -1927,6 +1970,14 @@ package body Prj.Nmsc is
(Lang_Index).Config.Toolchain_Version := (Lang_Index).Config.Toolchain_Version :=
Element.Value.Value; 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 => when others =>
null; null;
end case; end case;
...@@ -1941,9 +1992,7 @@ package body Prj.Nmsc is ...@@ -1941,9 +1992,7 @@ package body Prj.Nmsc is
begin begin
Process_Project_Level_Simple_Attributes; Process_Project_Level_Simple_Attributes;
Process_Project_Level_Array_Attributes; Process_Project_Level_Array_Attributes;
Process_Packages; Process_Packages;
-- For unit based languages, set Casing, Dot_Replacement and -- For unit based languages, set Casing, Dot_Replacement and
...@@ -3169,12 +3218,11 @@ package body Prj.Nmsc is ...@@ -3169,12 +3218,11 @@ package body Prj.Nmsc is
-- For all unit based languages, if any, set the specified -- For all unit based languages, if any, set the specified
-- value of Dot_Replacement, Casing and/or Separate_Suffix. -- value of Dot_Replacement, Casing and/or Separate_Suffix.
if Dot_Replacement /= No_File or else if Dot_Replacement /= No_File
Casing_Defined or else or else Casing_Defined
Separate_Suffix /= No_File or else Separate_Suffix /= No_File
then then
Lang_Id := Data.First_Language_Processing; Lang_Id := Data.First_Language_Processing;
while Lang_Id /= No_Language_Index loop while Lang_Id /= No_Language_Index loop
if In_Tree.Languages_Data.Table if In_Tree.Languages_Data.Table
(Lang_Id).Config.Kind = Unit_Based (Lang_Id).Config.Kind = Unit_Based
...@@ -3207,10 +3255,11 @@ package body Prj.Nmsc is ...@@ -3207,10 +3255,11 @@ package body Prj.Nmsc is
declare declare
Suffix : Variable_Value; Suffix : Variable_Value;
Lang_Id : Language_Index;
Lang_Id : Language_Index := Data.First_Language_Processing;
Lang : Name_Id; Lang : Name_Id;
begin begin
Lang_Id := Data.First_Language_Processing;
while Lang_Id /= No_Language_Index loop while Lang_Id /= No_Language_Index loop
Lang := In_Tree.Languages_Data.Table (Lang_Id).Name; Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
...@@ -3384,6 +3433,8 @@ package body Prj.Nmsc is ...@@ -3384,6 +3433,8 @@ package body Prj.Nmsc is
end if; end if;
end Check_Library; end Check_Library;
-- Start of processing for Check_Library_Attributes
begin begin
-- Special case of extending project -- Special case of extending project
...@@ -3393,9 +3444,9 @@ package body Prj.Nmsc is ...@@ -3393,9 +3444,9 @@ package body Prj.Nmsc is
In_Tree.Projects.Table (Data.Extends); In_Tree.Projects.Table (Data.Extends);
begin begin
-- If the project extended is a library project, we inherit -- If the project extended is a library project, we inherit the
-- the library name, if it is not redefined; we check that -- library name, if it is not redefined; we check that the library
-- the library directory is specified. -- directory is specified.
if Extended_Data.Library then if Extended_Data.Library then
if Lib_Name.Default then if Lib_Name.Default then
...@@ -3606,7 +3657,7 @@ package body Prj.Nmsc is ...@@ -3606,7 +3657,7 @@ package body Prj.Nmsc is
else else
if Lib_ALI_Dir.Value = Empty_String then if Lib_ALI_Dir.Value = Empty_String then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("No library 'A'L'I directory specified"); Write_Line ("No library ALI directory specified");
end if; end if;
Data.Library_ALI_Dir := Data.Library_Dir; Data.Library_ALI_Dir := Data.Library_Dir;
Data.Display_Library_ALI_Dir := Data.Display_Library_Dir; Data.Display_Library_ALI_Dir := Data.Display_Library_Dir;
...@@ -3946,10 +3997,11 @@ package body Prj.Nmsc is ...@@ -3946,10 +3997,11 @@ package body Prj.Nmsc is
end; end;
declare declare
Current : Array_Element_Id := Data.Naming.Spec_Suffix; Current : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
begin begin
Current := Data.Naming.Spec_Suffix;
while Current /= No_Array_Element loop while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current); Element := In_Tree.Array_Elements.Table (Current);
Get_Name_String (Element.Value.Value); Get_Name_String (Element.Value.Value);
...@@ -3987,12 +4039,11 @@ package body Prj.Nmsc is ...@@ -3987,12 +4039,11 @@ package body Prj.Nmsc is
if Impl_Suffixs /= No_Array_Element then if Impl_Suffixs /= No_Array_Element then
Suffix := Data.Naming.Body_Suffix; Suffix := Data.Naming.Body_Suffix;
while Suffix /= No_Array_Element loop while Suffix /= No_Array_Element loop
Element := Element :=
In_Tree.Array_Elements.Table (Suffix); In_Tree.Array_Elements.Table (Suffix);
Suffix2 := Impl_Suffixs;
Suffix2 := Impl_Suffixs;
while Suffix2 /= No_Array_Element loop while Suffix2 /= No_Array_Element loop
exit when In_Tree.Array_Elements.Table exit when In_Tree.Array_Elements.Table
(Suffix2).Index = Element.Index; (Suffix2).Index = Element.Index;
...@@ -4001,8 +4052,7 @@ package body Prj.Nmsc is ...@@ -4001,8 +4052,7 @@ package body Prj.Nmsc is
end loop; end loop;
-- There is a registered default suffix, but no suffix was -- There is a registered default suffix, but no suffix was
-- specified in the project file. Add the default to the -- specified in the project file. Add default to the array.
-- array.
if Suffix2 = No_Array_Element then if Suffix2 = No_Array_Element then
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last
...@@ -4029,10 +4079,11 @@ package body Prj.Nmsc is ...@@ -4029,10 +4079,11 @@ package body Prj.Nmsc is
end; end;
declare declare
Current : Array_Element_Id := Data.Naming.Body_Suffix; Current : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
begin begin
Current := Data.Naming.Body_Suffix;
while Current /= No_Array_Element loop while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current); Element := In_Tree.Array_Elements.Table (Current);
Get_Name_String (Element.Value.Value); Get_Name_String (Element.Value.Value);
...@@ -4170,6 +4221,7 @@ package body Prj.Nmsc is ...@@ -4170,6 +4221,7 @@ package body Prj.Nmsc is
begin begin
if Get_Mode = Ada_Only then if Get_Mode = Ada_Only then
-- Assume that there is no language specified yet -- Assume that there is no language specified yet
Data.Other_Sources_Present := False; Data.Other_Sources_Present := False;
...@@ -4356,16 +4408,13 @@ package body Prj.Nmsc is ...@@ -4356,16 +4408,13 @@ package body Prj.Nmsc is
In_Tree); In_Tree);
Auto_Init_Supported : Boolean; Auto_Init_Supported : Boolean;
OK : Boolean := True; OK : Boolean := True;
Source : Source_Id; Source : Source_Id;
Next_Proj : Project_Id; Next_Proj : Project_Id;
begin begin
if Get_Mode = Multi_Language then if Get_Mode = Multi_Language then
Auto_Init_Supported := Data.Config.Auto_Init_Supported; Auto_Init_Supported := Data.Config.Auto_Init_Supported;
else else
Auto_Init_Supported := Auto_Init_Supported :=
MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported; MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
...@@ -4399,6 +4448,7 @@ package body Prj.Nmsc is ...@@ -4399,6 +4448,7 @@ package body Prj.Nmsc is
ALI : constant String := ALI : constant String :=
ALI_File_Name (Name_Buffer (1 .. Name_Len)); ALI_File_Name (Name_Buffer (1 .. Name_Len));
ALI_Name_Id : Name_Id; ALI_Name_Id : Name_Id;
begin begin
Name_Len := ALI'Length; Name_Len := ALI'Length;
Name_Buffer (1 .. Name_Len) := ALI; Name_Buffer (1 .. Name_Len) := ALI;
...@@ -4650,8 +4700,8 @@ package body Prj.Nmsc is ...@@ -4650,8 +4700,8 @@ package body Prj.Nmsc is
if Lib_Auto_Init.Default then if Lib_Auto_Init.Default then
-- If no attribute Library_Auto_Init is declared, then -- If no attribute Library_Auto_Init is declared, then set auto
-- set auto init only if it is supported. -- init only if it is supported.
Data.Lib_Auto_Init := Auto_Init_Supported; Data.Lib_Auto_Init := Auto_Init_Supported;
...@@ -4667,8 +4717,8 @@ package body Prj.Nmsc is ...@@ -4667,8 +4717,8 @@ package body Prj.Nmsc is
Data.Lib_Auto_Init := True; Data.Lib_Auto_Init := True;
else else
-- Library_Auto_Init cannot be "true" if auto init -- Library_Auto_Init cannot be "true" if auto init is not
-- is not supported -- supported
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
...@@ -4686,12 +4736,11 @@ package body Prj.Nmsc is ...@@ -4686,12 +4736,11 @@ package body Prj.Nmsc is
end if; end if;
end SAL_Library; end SAL_Library;
-- If attribute Library_Src_Dir is defined and not the -- If attribute Library_Src_Dir is defined and not the empty string,
-- empty string, check if the directory exist and is not -- check if the directory exist and is not the object directory or
-- the object directory or one of the source directories. -- one of the source directories. This is the directory where copies
-- This is the directory where copies of the interface -- of the interface sources will be copied. Note that this directory
-- sources will be copied. Note that this directory may be -- may be the library directory.
-- the library directory.
if Lib_Src_Dir.Value /= Empty_String then if Lib_Src_Dir.Value /= Empty_String then
declare declare
...@@ -4713,8 +4762,8 @@ package body Prj.Nmsc is ...@@ -4713,8 +4762,8 @@ package body Prj.Nmsc is
if Data.Library_Src_Dir = No_Path then if Data.Library_Src_Dir = No_Path then
-- Get the absolute name of the library directory -- Get the absolute name of the library directory that does
-- that does not exist, to report an error. -- not exist, to report an error.
declare declare
Dir_Name : constant String := Dir_Name : constant String :=
...@@ -4751,8 +4800,7 @@ package body Prj.Nmsc is ...@@ -4751,8 +4800,7 @@ package body Prj.Nmsc is
Lib_Src_Dir.Location); Lib_Src_Dir.Location);
end; end;
-- Report an error if it is the same as the object -- Report error if it is the same as the object directory
-- directory.
elsif Data.Library_Src_Dir = Data.Object_Directory then elsif Data.Library_Src_Dir = Data.Object_Directory then
Error_Msg Error_Msg
...@@ -4773,8 +4821,7 @@ package body Prj.Nmsc is ...@@ -4773,8 +4821,7 @@ package body Prj.Nmsc is
Src_Dirs := Data.Source_Dirs; Src_Dirs := Data.Source_Dirs;
while Src_Dirs /= Nil_String loop while Src_Dirs /= Nil_String loop
Src_Dir := In_Tree.String_Elements.Table Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
(Src_Dirs);
-- Report error if it is one of the source directories -- Report error if it is one of the source directories
...@@ -5105,6 +5152,7 @@ package body Prj.Nmsc is ...@@ -5105,6 +5152,7 @@ package body Prj.Nmsc is
procedure Add_File is procedure Add_File is
File : File_Name_Type; File : File_Name_Type;
begin begin
Add ('"'); Add ('"');
File_Number := File_Number + 1; File_Number := File_Number + 1;
...@@ -5131,6 +5179,7 @@ package body Prj.Nmsc is ...@@ -5131,6 +5179,7 @@ package body Prj.Nmsc is
procedure Add_Name is procedure Add_Name is
Name : Name_Id; Name : Name_Id;
begin begin
Add ('"'); Add ('"');
Name_Number := Name_Number + 1; Name_Number := Name_Number + 1;
...@@ -5171,7 +5220,7 @@ package body Prj.Nmsc is ...@@ -5171,7 +5220,7 @@ package body Prj.Nmsc is
First := First + 1; First := First + 1;
-- Warning character is always the first one in this package -- Warning character is always the first one in this package
-- this is an undocumented kludge!!! -- this is an undocumented kludge???
elsif Msg (First) = '?' then elsif Msg (First) = '?' then
First := First + 1; First := First + 1;
...@@ -5248,7 +5297,7 @@ package body Prj.Nmsc is ...@@ -5248,7 +5297,7 @@ package body Prj.Nmsc is
Write_Line (Source_Directory); Write_Line (Source_Directory);
end if; end if;
-- We look to every entry in the source directory -- We look at every entry in the source directory
Open (Dir, Source_Directory Open (Dir, Source_Directory
(Source_Directory'First .. Dir_Last)); (Source_Directory'First .. Dir_Last));
...@@ -5318,10 +5367,9 @@ package body Prj.Nmsc is ...@@ -5318,10 +5367,9 @@ package body Prj.Nmsc is
Write_Line ("end Looking for sources."); Write_Line ("end Looking for sources.");
end if; end if;
-- If we have looked for sources and found none, then -- If we have looked for sources and found none, then it is an error,
-- it is an error, except if it is an extending project. -- except if it is an extending project. If a non extending project is
-- If a non extending project is not supposed to contain -- not supposed to contain any source, then never call Find_Ada_Sources.
-- any source, then we never call Find_Ada_Sources.
if Current_Source = Nil_String and then if Current_Source = Nil_String and then
Data.Extends = No_Project Data.Extends = No_Project
...@@ -5341,7 +5389,7 @@ package body Prj.Nmsc is ...@@ -5341,7 +5389,7 @@ package body Prj.Nmsc is
For_Language : Language_Index; For_Language : Language_Index;
Follow_Links : Boolean := False) Follow_Links : Boolean := False)
is is
Source_Dir : String_List_Id := Data.Source_Dirs; Source_Dir : String_List_Id;
Element : String_Element; Element : String_Element;
Dir : Dir_Type; Dir : Dir_Type;
Current_Source : String_List_Id := Nil_String; Current_Source : String_List_Id := Nil_String;
...@@ -5352,8 +5400,9 @@ package body Prj.Nmsc is ...@@ -5352,8 +5400,9 @@ package body Prj.Nmsc is
Write_Line ("Looking for sources:"); Write_Line ("Looking for sources:");
end if; end if;
-- For each subdirectory -- Loop through subdirectories
Source_Dir := Data.Source_Dirs;
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
begin begin
Source_Recorded := False; Source_Recorded := False;
...@@ -5464,10 +5513,10 @@ package body Prj.Nmsc is ...@@ -5464,10 +5513,10 @@ package body Prj.Nmsc is
if For_Language = Ada_Language_Index then if For_Language = Ada_Language_Index then
-- If we have looked for sources and found none, then -- If we have looked for sources and found none, then it is an error,
-- it is an error, except if it is an extending project. -- except if it is an extending project. If a non extending project
-- If a non extending project is not supposed to contain -- is not supposed to contain any source files, then never call
-- any source, then we never call Find_Sources. -- Find_Sources.
if Current_Source /= Nil_String then if Current_Source /= Nil_String then
Data.Ada_Sources_Present := True; Data.Ada_Sources_Present := True;
...@@ -5527,8 +5576,7 @@ package body Prj.Nmsc is ...@@ -5527,8 +5576,7 @@ package body Prj.Nmsc is
Location : Source_Ptr; Location : Source_Ptr;
Removed : Boolean := False); Removed : Boolean := False);
-- Find one or several source directories, and add (or remove, if -- Find one or several source directories, and add (or remove, if
-- Removed is True) them to the list of source directories of the -- Removed is True) them to list of source directories of the project.
-- project.
---------------------- ----------------------
-- Find_Source_Dirs -- -- Find_Source_Dirs --
...@@ -5554,8 +5602,8 @@ package body Prj.Nmsc is ...@@ -5554,8 +5602,8 @@ package body Prj.Nmsc is
Dir : Dir_Type; Dir : Dir_Type;
Name : String (1 .. 250); Name : String (1 .. 250);
Last : Natural; Last : Natural;
List : String_List_Id := Data.Source_Dirs; List : String_List_Id;
Prev : String_List_Id := Nil_String; Prev : String_List_Id;
Element : String_Element; Element : String_Element;
Found : Boolean := False; Found : Boolean := False;
...@@ -5579,9 +5627,9 @@ package body Prj.Nmsc is ...@@ -5579,9 +5627,9 @@ package body Prj.Nmsc is
Canonical_Path := Name_Find; Canonical_Path := Name_Find;
-- To avoid processing the same directory several times, check -- To avoid processing the same directory several times, check
-- if the directory is already in Recursive_Dirs. If it is, -- if the directory is already in Recursive_Dirs. If it is, then
-- then there is nothing to do, just return. If it is not, put -- there is nothing to do, just return. If it is not, put it there
-- it there and continue recursive processing. -- and continue recursive processing.
if not Removed then if not Removed then
if Recursive_Dirs.Get (Canonical_Path) then if Recursive_Dirs.Get (Canonical_Path) then
...@@ -5593,6 +5641,8 @@ package body Prj.Nmsc is ...@@ -5593,6 +5641,8 @@ package body Prj.Nmsc is
-- Check if directory is already in list -- Check if directory is already in list
List := Data.Source_Dirs;
Prev := Nil_String;
while List /= Nil_String loop while List /= Nil_String loop
Element := In_Tree.String_Elements.Table (List); Element := In_Tree.String_Elements.Table (List);
...@@ -7564,9 +7614,26 @@ package body Prj.Nmsc is ...@@ -7564,9 +7614,26 @@ package body Prj.Nmsc is
end if; end if;
end Search_Directories; 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 -- Start of processing for Look_For_Sources
begin 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 if Get_Mode = Ada_Only and then
Is_A_Language (In_Tree, Data, "ada") Is_A_Language (In_Tree, Data, "ada")
then then
...@@ -7583,12 +7650,6 @@ package body Prj.Nmsc is ...@@ -7583,12 +7650,6 @@ package body Prj.Nmsc is
Data.Decl.Attributes, Data.Decl.Attributes,
In_Tree); In_Tree);
Excluded_Sources : Variable_Value :=
Util.Value_Of
(Name_Excluded_Source_Files,
Data.Decl.Attributes,
In_Tree);
begin begin
pragma Assert pragma Assert
(Sources.Kind = List, (Sources.Kind = List,
...@@ -7708,17 +7769,6 @@ package body Prj.Nmsc is ...@@ -7708,17 +7769,6 @@ package body Prj.Nmsc is
(Project, In_Tree, Data, Follow_Links); (Project, In_Tree, Data, Follow_Links);
end if; 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 -- If there are sources that are locally removed, mark them as
-- such in the Units table. -- such in the Units table.
...@@ -8120,25 +8170,9 @@ package body Prj.Nmsc is ...@@ -8120,25 +8170,9 @@ package body Prj.Nmsc is
Data.Decl.Attributes, Data.Decl.Attributes,
In_Tree); In_Tree);
Excluded_Sources : Variable_Value :=
Util.Value_Of
(Name_Excluded_Source_Files,
Data.Decl.Attributes,
In_Tree);
Name_Loc : Name_Location; Name_Loc : Name_Location;
begin 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 Sources.Default then
if not Source_List_File.Default then if not Source_List_File.Default then
Error_Msg Error_Msg
...@@ -8314,8 +8348,7 @@ package body Prj.Nmsc is ...@@ -8314,8 +8348,7 @@ package body Prj.Nmsc is
function Path_Name_Of function Path_Name_Of
(File_Name : File_Name_Type; (File_Name : File_Name_Type;
Directory : Path_Name_Type) Directory : Path_Name_Type) return String
return String
is is
Result : String_Access; Result : String_Access;
......
gcc/ada/prj-part.adb
...@@ -439,7 +439,9 @@ package body Prj.Part is ...@@ -439,7 +439,9 @@ package body Prj.Part is
Store_Comments : Boolean := False) Store_Comments : Boolean := False)
is is
Current_Directory : constant String := Get_Current_Dir; Current_Directory : constant String := Get_Current_Dir;
Dummy : Boolean; Dummy : Boolean;
pragma Warnings (Off, Dummy);
Real_Project_File_Name : String_Access := Real_Project_File_Name : String_Access :=
Osint.To_Canonical_File_Spec Osint.To_Canonical_File_Spec
...@@ -1055,17 +1057,9 @@ package body Prj.Part is ...@@ -1055,17 +1057,9 @@ package body Prj.Part is
-- or not following Ada identifier's syntax). -- or not following Ada identifier's syntax).
Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name); 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", Error_Msg ("?{ is not a valid path name for a project file",
Token_Ptr); Token_Ptr);
end if; end if;
end if;
if Current_Verbosity >= Medium then if Current_Verbosity >= Medium then
Write_Str ("Parsing """); Write_Str ("Parsing """);
...@@ -1234,6 +1228,7 @@ package body Prj.Part is ...@@ -1234,6 +1228,7 @@ package body Prj.Part is
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end; end;
if not In_Configuration then
declare declare
Name_And_Node : Tree_Private_Part.Project_Name_And_Node := Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_First Tree_Private_Part.Projects_Htable.Get_First
...@@ -1257,16 +1252,17 @@ package body Prj.Part is ...@@ -1257,16 +1252,17 @@ package body Prj.Part is
if Project_Name /= No_Name then if Project_Name /= No_Name then
Error_Msg_Name_1 := Project_Name; Error_Msg_Name_1 := Project_Name;
Error_Msg Error_Msg
("duplicate project name %%", Location_Of (Project, In_Tree)); ("duplicate project name %%",
Location_Of (Project, In_Tree));
Error_Msg_Name_1 := Error_Msg_Name_1 :=
Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree)); Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
Error_Msg Error_Msg
("\already in %%", Location_Of (Project, In_Tree)); ("\already in %%", Location_Of (Project, In_Tree));
else else
-- Otherwise, add the name of the project to the hash table, so -- Otherwise, add the name of the project to the hash table,
-- that we can check that no other subsequent project will have -- so that we can check that no other subsequent project
-- the same name. -- will have the same name.
Tree_Private_Part.Projects_Htable.Set Tree_Private_Part.Projects_Htable.Set
(T => In_Tree.Projects_HT, (T => In_Tree.Projects_HT,
...@@ -1277,6 +1273,7 @@ package body Prj.Part is ...@@ -1277,6 +1273,7 @@ package body Prj.Part is
Extended => Extended)); Extended => Extended));
end if; end if;
end; end;
end if;
end if; end if;
......
gcc/ada/prj-proc.adb
...@@ -766,6 +766,7 @@ package body Prj.Proc is ...@@ -766,6 +766,7 @@ package body Prj.Proc is
The_Array : Array_Id := No_Array; The_Array : Array_Id := No_Array;
The_Element : Array_Element_Id := No_Array_Element; The_Element : Array_Element_Id := No_Array_Element;
Array_Index : Name_Id := No_Name; Array_Index : Name_Id := No_Name;
Lower : Boolean;
begin begin
if The_Package /= No_Package then if The_Package /= No_Package then
...@@ -792,9 +793,26 @@ package body Prj.Proc is ...@@ -792,9 +793,26 @@ package body Prj.Proc is
Get_Name_String (Index); Get_Name_String (Index);
if Case_Insensitive Lower :=
(The_Current_Term, From_Project_Node_Tree) Case_Insensitive
then (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)); To_Lower (Name_Buffer (1 .. Name_Len));
end if; end if;
...@@ -1875,12 +1893,32 @@ package body Prj.Proc is ...@@ -1875,12 +1893,32 @@ package body Prj.Proc is
-- Put in lower case, if necessary -- Put in lower case, if necessary
if Case_Insensitive declare
(Current_Item, From_Project_Node_Tree) Lower : Boolean;
then
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 GNAT.Case_Util.To_Lower
(Name_Buffer (1 .. Name_Len)); (Name_Buffer (1 .. Name_Len));
end if; end if;
end;
declare declare
The_Array : Array_Id; The_Array : Array_Id;
...@@ -1895,18 +1933,19 @@ package body Prj.Proc is ...@@ -1895,18 +1933,19 @@ package body Prj.Proc is
-- Look for the array in the appropriate list -- Look for the array in the appropriate list
if Pkg /= No_Package then if Pkg /= No_Package then
The_Array := In_Tree.Packages.Table The_Array :=
(Pkg).Decl.Arrays; In_Tree.Packages.Table (Pkg).Decl.Arrays;
else else
The_Array := In_Tree.Projects.Table The_Array :=
(Project).Decl.Arrays; In_Tree.Projects.Table (Project).Decl.Arrays;
end if; end if;
while while
The_Array /= No_Array The_Array /= No_Array
and then In_Tree.Arrays.Table and then
(The_Array).Name /= Current_Item_Name In_Tree.Arrays.Table (The_Array).Name /=
Current_Item_Name
loop loop
The_Array := In_Tree.Arrays.Table The_Array := In_Tree.Arrays.Table
(The_Array).Next; (The_Array).Next;
...@@ -1918,27 +1957,22 @@ package body Prj.Proc is ...@@ -1918,27 +1957,22 @@ package body Prj.Proc is
-- created automatically later -- created automatically later
if The_Array = No_Array then if The_Array = No_Array then
Array_Table.Increment_Last Array_Table.Increment_Last (In_Tree.Arrays);
(In_Tree.Arrays); The_Array := Array_Table.Last (In_Tree.Arrays);
The_Array := Array_Table.Last
(In_Tree.Arrays);
if Pkg /= No_Package then if Pkg /= No_Package then
In_Tree.Arrays.Table In_Tree.Arrays.Table (The_Array) :=
(The_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Value => No_Array_Element, Value => No_Array_Element,
Next => Next =>
In_Tree.Packages.Table In_Tree.Packages.Table
(Pkg).Decl.Arrays); (Pkg).Decl.Arrays);
In_Tree.Packages.Table In_Tree.Packages.Table (Pkg).Decl.Arrays :=
(Pkg).Decl.Arrays :=
The_Array; The_Array;
else else
In_Tree.Arrays.Table In_Tree.Arrays.Table (The_Array) :=
(The_Array) :=
(Name => Current_Item_Name, (Name => Current_Item_Name,
Value => No_Array_Element, Value => No_Array_Element,
Next => Next =>
...@@ -1946,8 +1980,7 @@ package body Prj.Proc is ...@@ -1946,8 +1980,7 @@ package body Prj.Proc is
(Project).Decl.Arrays); (Project).Decl.Arrays);
In_Tree.Projects.Table In_Tree.Projects.Table
(Project).Decl.Arrays := (Project).Decl.Arrays := The_Array;
The_Array;
end if; end if;
-- Otherwise initialize The_Array_Element as the -- Otherwise initialize The_Array_Element as the
...@@ -1955,8 +1988,7 @@ package body Prj.Proc is ...@@ -1955,8 +1988,7 @@ package body Prj.Proc is
else else
The_Array_Element := The_Array_Element :=
In_Tree.Arrays.Table In_Tree.Arrays.Table (The_Array).Value;
(The_Array).Value;
end if; end if;
-- Look in the list, if any, to find an element -- Look in the list, if any, to find an element
...@@ -2038,7 +2070,7 @@ package body Prj.Proc is ...@@ -2038,7 +2070,7 @@ package body Prj.Proc is
Name : Name_Id := No_Name; Name : Name_Id := No_Name;
begin begin
-- If a project were specified for the case variable, -- If a project was specified for the case variable,
-- get its id. -- get its id.
if Project_Node_Of if Project_Node_Of
...@@ -2223,7 +2255,6 @@ package body Prj.Proc is ...@@ -2223,7 +2255,6 @@ package body Prj.Proc is
is is
begin begin
Error_Report := Report_Error; Error_Report := Report_Error;
Success := True;
if Reset_Tree then if Reset_Tree then
...@@ -2244,6 +2275,10 @@ package body Prj.Proc is ...@@ -2244,6 +2275,10 @@ package body Prj.Proc is
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project); 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; end Process_Project_Tree_Phase_1;
---------------------------------- ----------------------------------
......
gcc/ada/prj-util.adb
...@@ -526,7 +526,8 @@ package body Prj.Util is ...@@ -526,7 +526,8 @@ package body Prj.Util is
is is
Current : Array_Element_Id; Current : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
Real_Index : Name_Id; Real_Index_1 : Name_Id;
Real_Index_2 : Name_Id;
begin begin
Current := In_Array; Current := In_Array;
...@@ -537,18 +538,25 @@ package body Prj.Util is ...@@ -537,18 +538,25 @@ package body Prj.Util is
Element := In_Tree.Array_Elements.Table (Current); 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 if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
Get_Name_String (Index); Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Real_Index := Name_Find; Real_Index_1 := Name_Find;
end if; end if;
while Current /= No_Array_Element loop while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current); 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 Src_Index = Element.Src_Index
then then
return Element.Value; return Element.Value;
......
gcc/ada/prj.ads
...@@ -370,6 +370,8 @@ package Prj is ...@@ -370,6 +370,8 @@ package Prj is
-- shared libraries. Specified in the configuration. When not specified, -- shared libraries. Specified in the configuration. When not specified,
-- there is no need for such switch. -- there is no need for such switch.
Runtime_Library_Dir : Name_Id := No_Name;
Mapping_File_Switches : Name_List_Index := No_Name_List; Mapping_File_Switches : Name_List_Index := No_Name_List;
-- The option(s) to provide a mapping file to the compiler. Specified in -- The option(s) to provide a mapping file to the compiler. Specified in
-- the configuration. When not ??? -- the configuration. When not ???
...@@ -417,6 +419,7 @@ package Prj is ...@@ -417,6 +419,7 @@ package Prj is
Compiler_Driver_Path => null, Compiler_Driver_Path => null,
Compiler_Required_Switches => No_Name_List, Compiler_Required_Switches => No_Name_List,
Compilation_PIC_Option => No_Name_List, Compilation_PIC_Option => No_Name_List,
Runtime_Library_Dir => No_Name,
Mapping_File_Switches => No_Name_List, Mapping_File_Switches => No_Name_List,
Mapping_Spec_Suffix => No_File, Mapping_Spec_Suffix => No_File,
Mapping_Body_Suffix => No_File, Mapping_Body_Suffix => No_File,
......
gcc/ada/snames.adb
...@@ -776,6 +776,7 @@ package body Snames is ...@@ -776,6 +776,7 @@ package body Snames is
"symbolic_link_supported#" & "symbolic_link_supported#" &
"toolchain_description#" & "toolchain_description#" &
"toolchain_version#" & "toolchain_version#" &
"runtime_library_dir#" &
"unaligned_valid#" & "unaligned_valid#" &
"interface#" & "interface#" &
"overriding#" & "overriding#" &
......
gcc/ada/snames.ads
...@@ -1092,25 +1092,26 @@ package Snames is ...@@ -1092,25 +1092,26 @@ package Snames is
Name_Symbolic_Link_Supported : constant Name_Id := N + 715; Name_Symbolic_Link_Supported : constant Name_Id := N + 715;
Name_Toolchain_Description : constant Name_Id := N + 716; Name_Toolchain_Description : constant Name_Id := N + 716;
Name_Toolchain_Version : constant Name_Id := N + 717; Name_Toolchain_Version : constant Name_Id := N + 717;
Name_Runtime_Library_Dir : constant Name_Id := N + 718;
-- Other miscellaneous names used in front end -- 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 -- Ada 2005 reserved words
First_2005_Reserved_Word : constant Name_Id := N + 719; First_2005_Reserved_Word : constant Name_Id := N + 720;
Name_Interface : constant Name_Id := N + 719; Name_Interface : constant Name_Id := N + 720;
Name_Overriding : constant Name_Id := N + 720; Name_Overriding : constant Name_Id := N + 721;
Name_Synchronized : constant Name_Id := N + 721; Name_Synchronized : constant Name_Id := N + 722;
Last_2005_Reserved_Word : constant Name_Id := N + 721; Last_2005_Reserved_Word : constant Name_Id := N + 722;
subtype Ada_2005_Reserved_Words is subtype Ada_2005_Reserved_Words is
Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word; Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
-- Mark last defined name for consistency check in Snames body -- 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 -- -- Subtypes Defining Name Categories --
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment