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 327 additions and 246 deletions
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
......
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 ..
......
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;
......
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;
......
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;
......
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;
----------------------------------
......
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;
......
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,
......
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#" &
......
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 --
......
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