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 153 additions and 105 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-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