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 ...@@ -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-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,16 +1057,8 @@ package body Prj.Part is ...@@ -1055,16 +1057,8 @@ 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);
Error_Msg ("?{ is not a valid path name for a project file",
if In_Configuration then Token_Ptr);
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;
end if; end if;
if Current_Verbosity >= Medium then if Current_Verbosity >= Medium then
...@@ -1234,49 +1228,52 @@ package body Prj.Part is ...@@ -1234,49 +1228,52 @@ 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;
declare if not In_Configuration then
Name_And_Node : Tree_Private_Part.Project_Name_And_Node := declare
Tree_Private_Part.Projects_Htable.Get_First Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
(In_Tree.Projects_HT); Tree_Private_Part.Projects_Htable.Get_First
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
(In_Tree.Projects_HT); (In_Tree.Projects_HT);
Project_Name := Name_And_Node.Name; Project_Name : Name_Id := Name_And_Node.Name;
end loop;
-- 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 -- Report an error if we already have a project with this name
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 if Project_Name /= No_Name then
-- Otherwise, add the name of the project to the hash table, so Error_Msg_Name_1 := Project_Name;
-- that we can check that no other subsequent project will have Error_Msg
-- the same name. ("duplicate project name %%",
Location_Of (Project, In_Tree));
Tree_Private_Part.Projects_Htable.Set Error_Msg_Name_1 :=
(T => In_Tree.Projects_HT, Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
K => Name_Of_Project, Error_Msg
E => (Name => Name_Of_Project, ("\already in %%", Location_Of (Project, In_Tree));
Node => Project,
Canonical_Path => Canonical_Path_Name, else
Extended => Extended)); -- Otherwise, add the name of the project to the hash table,
end if; -- so that we can check that no other subsequent project
end; -- 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; 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
GNAT.Case_Util.To_Lower begin
(Name_Buffer (1 .. Name_Len)); Lower :=
end if; 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 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
...@@ -1984,16 +2016,16 @@ package body Prj.Proc is ...@@ -1984,16 +2016,16 @@ package body Prj.Proc is
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table
(The_Array_Element) := (The_Array_Element) :=
(Index => Index_Name, (Index => Index_Name,
Src_Index => Src_Index =>
Source_Index_Of Source_Index_Of
(Current_Item, From_Project_Node_Tree), (Current_Item, From_Project_Node_Tree),
Index_Case_Sensitive => Index_Case_Sensitive =>
not Case_Insensitive not Case_Insensitive
(Current_Item, From_Project_Node_Tree), (Current_Item, From_Project_Node_Tree),
Value => New_Value, Value => New_Value,
Next => In_Tree.Arrays.Table Next => In_Tree.Arrays.Table
(The_Array).Value); (The_Array).Value);
In_Tree.Arrays.Table In_Tree.Arrays.Table
(The_Array).Value := The_Array_Element; (The_Array).Value := The_Array_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
...@@ -524,9 +524,10 @@ package body Prj.Util is ...@@ -524,9 +524,10 @@ package body Prj.Util is
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Force_Lower_Case_Index : Boolean := False) return Variable_Value Force_Lower_Case_Index : Boolean := False) return Variable_Value
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