Skip to content

R
riscv-gcc-1
Commit 86828d40 by Arnaud Charlet
Options

[multiple changes] 

2011-09-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification): If the domain
	of iteration is an expression, its value must be captured in a
	renaming declaration, so that modification of the elements is
	propagated to the original container.

2011-09-02  Pascal Obry  <obry@adacore.com>

	* prj-proc.adb, prj.adb, makeutl.adb, makeutl.ads, prj-dect.adb,
	prj-nmsc.adb, prj-util.adb, prj-conf.adb, prj-env.adb,
	prj-tree.adb: Minor reformatting and style fixes.

From-SVN: r178443
parent da6feece
Showing with 306 additions and 294 deletions
gcc/ada/ChangeLog
2011-09-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): If the domain
of iteration is an expression, its value must be captured in a
renaming declaration, so that modification of the elements is
propagated to the original container.
2011-09-02 Pascal Obry <obry@adacore.com>
* prj-proc.adb, prj.adb, makeutl.adb, makeutl.ads, prj-dect.adb,
prj-nmsc.adb, prj-util.adb, prj-conf.adb, prj-env.adb,
prj-tree.adb: Minor reformatting and style fixes.
2011-09-02 Robert Dewar <dewar@adacore.com> 2011-09-02 Robert Dewar <dewar@adacore.com>
* s-rident.ads: Add new restriction No_Implicit_Aliasing * s-rident.ads: Add new restriction No_Implicit_Aliasing
......
gcc/ada/makeutl.adb
...@@ -850,9 +850,7 @@ package body Makeutl is ...@@ -850,9 +850,7 @@ package body Makeutl is
Allow_Wildcards => True); Allow_Wildcards => True);
end if; end if;
if Value = Nil_Variable_Value if Value = Nil_Variable_Value and then Test_Without_Suffix then
and then Test_Without_Suffix
then
Lang := Lang :=
Get_Language_From_Name (Project, Get_Name_String (Source_Lang)); Get_Language_From_Name (Project, Get_Name_String (Source_Lang));
...@@ -872,8 +870,8 @@ package body Makeutl is ...@@ -872,8 +870,8 @@ package body Makeutl is
Name (1 .. Last) := SF_Name; Name (1 .. Last) := SF_Name;
if Last > Body_Suffix'Length if Last > Body_Suffix'Length
and then Name (Last - Body_Suffix'Length + 1 .. Last) = and then
Body_Suffix Name (Last - Body_Suffix'Length + 1 .. Last) = Body_Suffix
then then
Truncated := True; Truncated := True;
Last := Last - Body_Suffix'Length; Last := Last - Body_Suffix'Length;
...@@ -881,8 +879,8 @@ package body Makeutl is ...@@ -881,8 +879,8 @@ package body Makeutl is
if not Truncated if not Truncated
and then Last > Spec_Suffix'Length and then Last > Spec_Suffix'Length
and then Name (Last - Spec_Suffix'Length + 1 .. Last) = and then
Spec_Suffix Name (Last - Spec_Suffix'Length + 1 .. Last) = Spec_Suffix
then then
Truncated := True; Truncated := True;
Last := Last - Spec_Suffix'Length; Last := Last - Spec_Suffix'Length;
...@@ -900,9 +898,7 @@ package body Makeutl is ...@@ -900,9 +898,7 @@ package body Makeutl is
Allow_Wildcards => True); Allow_Wildcards => True);
end if; end if;
if Value = Nil_Variable_Value if Value = Nil_Variable_Value and then Check_ALI_Suffix then
and then Check_ALI_Suffix
then
Last := SF_Name'Length; Last := SF_Name'Length;
while Name (Last) /= '.' loop while Name (Last) /= '.' loop
Last := Last - 1; Last := Last - 1;
...@@ -994,9 +990,12 @@ package body Makeutl is ...@@ -994,9 +990,12 @@ package body Makeutl is
------------------------------ ------------------------------
procedure Initialize_Source_Record (Source : Prj.Source_Id) is procedure Initialize_Source_Record (Source : Prj.Source_Id) is
procedure Set_Object_Project procedure Set_Object_Project
(Obj_Dir : String; Obj_Proj : Project_Id; Obj_Path : Path_Name_Type; (Obj_Dir : String;
Stamp : Time_Stamp_Type); Obj_Proj : Project_Id;
Obj_Path : Path_Name_Type;
Stamp : Time_Stamp_Type);
-- Update information about object file, switches file,... -- Update information about object file, switches file,...
------------------------ ------------------------
...@@ -1004,8 +1003,10 @@ package body Makeutl is ...@@ -1004,8 +1003,10 @@ package body Makeutl is
------------------------ ------------------------
procedure Set_Object_Project procedure Set_Object_Project
(Obj_Dir : String; Obj_Proj : Project_Id; Obj_Path : Path_Name_Type; (Obj_Dir : String;
Stamp : Time_Stamp_Type) is Obj_Proj : Project_Id;
Obj_Path : Path_Name_Type;
Stamp : Time_Stamp_Type) is
begin begin
Source.Object_Project := Obj_Proj; Source.Object_Project := Obj_Proj;
Source.Object_Path := Obj_Path; Source.Object_Path := Obj_Path;
...@@ -1031,10 +1032,11 @@ package body Makeutl is ...@@ -1031,10 +1032,11 @@ package body Makeutl is
declare declare
Switches_Path : constant String := Switches_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => Get_Name_String (Source.Switches), (Name =>
Resolve_Links => Opt.Follow_Links_For_Files, Get_Name_String (Source.Switches),
Directory => Obj_Dir); Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Obj_Dir);
begin begin
Source.Switches_Path := Create_Name (Switches_Path); Source.Switches_Path := Create_Name (Switches_Path);
...@@ -1093,21 +1095,22 @@ package body Makeutl is ...@@ -1093,21 +1095,22 @@ package body Makeutl is
-- elsewhere that's where we'll expect to find it). -- elsewhere that's where we'll expect to find it).
Obj_Proj := Source.Project; Obj_Proj := Source.Project;
while Obj_Proj /= No_Project loop while Obj_Proj /= No_Project loop
declare declare
Dir : constant String := Get_Name_String Dir : constant String :=
(Obj_Proj.Object_Directory.Display_Name); Get_Name_String
(Obj_Proj.Object_Directory.Display_Name);
Object_Path : constant String := Object_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => (Name =>
Get_Name_String (Source.Object), Get_Name_String (Source.Object),
Resolve_Links => Resolve_Links => Opt.Follow_Links_For_Files,
Opt.Follow_Links_For_Files, Directory => Dir);
Directory => Dir);
Obj_Path : constant Path_Name_Type := Create_Name (Object_Path); Obj_Path : constant Path_Name_Type := Create_Name (Object_Path);
Stamp : Time_Stamp_Type := Empty_Time_Stamp; Stamp : Time_Stamp_Type := Empty_Time_Stamp;
begin begin
-- For specs, we do not check object files if there is a body. -- For specs, we do not check object files if there is a body.
...@@ -1286,10 +1289,10 @@ package body Makeutl is ...@@ -1286,10 +1289,10 @@ package body Makeutl is
for Index in reverse 1 .. Linker_Opts.Last loop for Index in reverse 1 .. Linker_Opts.Last loop
declare declare
Options : String_List_Id; Options : String_List_Id;
Proj : constant Project_Id := Proj : constant Project_Id :=
Linker_Opts.Table (Index).Project; Linker_Opts.Table (Index).Project;
Option : Name_Id; Option : Name_Id;
Dir_Path : constant String := Dir_Path : constant String :=
Get_Name_String (Proj.Directory.Name); Get_Name_String (Proj.Directory.Name);
...@@ -1397,12 +1400,12 @@ package body Makeutl is ...@@ -1397,12 +1400,12 @@ package body Makeutl is
procedure Add_Multi_Unit_Sources procedure Add_Multi_Unit_Sources
(Tree : Project_Tree_Ref; (Tree : Project_Tree_Ref;
Source : Prj.Source_Id); Source : Prj.Source_Id);
-- Add all units from the same file as the multi-unit Source. -- Add all units from the same file as the multi-unit Source
function Find_File_Add_Extension function Find_File_Add_Extension
(Tree : Project_Tree_Ref; (Tree : Project_Tree_Ref;
Base_Main : String) return Prj.Source_Id; Base_Main : String) return Prj.Source_Id;
-- Search for Main in the project, adding body or spec extensions. -- Search for Main in the project, adding body or spec extensions
---------------------------- ----------------------------
-- Add_Multi_Unit_Sources -- -- Add_Multi_Unit_Sources --
...@@ -1455,8 +1458,8 @@ package body Makeutl is ...@@ -1455,8 +1458,8 @@ package body Makeutl is
----------------------------- -----------------------------
function Find_File_Add_Extension function Find_File_Add_Extension
(Tree : Project_Tree_Ref; (Tree : Project_Tree_Ref;
Base_Main : String) return Prj.Source_Id Base_Main : String) return Prj.Source_Id
is is
Spec_Source : Prj.Source_Id := No_Source; Spec_Source : Prj.Source_Id := No_Source;
Source : Prj.Source_Id; Source : Prj.Source_Id;
...@@ -1464,7 +1467,7 @@ package body Makeutl is ...@@ -1464,7 +1467,7 @@ package body Makeutl is
Suffix : File_Name_Type; Suffix : File_Name_Type;
begin begin
Source := No_Source; Source := No_Source;
Iter := For_Each_Source (Tree); -- In all projects Iter := For_Each_Source (Tree); -- In all projects
loop loop
Source := Prj.Element (Iter); Source := Prj.Element (Iter);
...@@ -1611,10 +1614,10 @@ package body Makeutl is ...@@ -1611,10 +1614,10 @@ package body Makeutl is
-- check later that we found the correct file. -- check later that we found the correct file.
Source := Find_Source Source := Find_Source
(In_Tree => File.Tree, (In_Tree => File.Tree,
Project => File.Project, Project => File.Project,
Base_Name => Main_Id, Base_Name => Main_Id,
Index => File.Index, Index => File.Index,
In_Imported_Only => True); In_Imported_Only => True);
if Source = No_Source then if Source = No_Source then
...@@ -1624,8 +1627,8 @@ package body Makeutl is ...@@ -1624,8 +1627,8 @@ package body Makeutl is
if Is_Absolute if Is_Absolute
and then Source /= No_Source and then Source /= No_Source
and then File_Name_Type (Source.Path.Name) /= and then
File.File File_Name_Type (Source.Path.Name) /= File.File
then then
Debug_Output Debug_Output
("Found a non-matching file", ("Found a non-matching file",
...@@ -2192,7 +2195,7 @@ package body Makeutl is ...@@ -2192,7 +2195,7 @@ package body Makeutl is
-- processed, if it hasn't already been processed. -- processed, if it hasn't already been processed.
function Insert_No_Roots (Source : Source_Info) return Boolean; function Insert_No_Roots (Source : Source_Info) return Boolean;
-- Insert Source, but do not look for its roots (see doc for Insert). -- Insert Source, but do not look for its roots (see doc for Insert)
------------------- -------------------
-- Was_Processed -- -- Was_Processed --
...@@ -2506,6 +2509,7 @@ package body Makeutl is ...@@ -2506,6 +2509,7 @@ package body Makeutl is
if Roots = Nil_Variable_Value then if Roots = Nil_Variable_Value then
Debug_Output (" -> no roots declared"); Debug_Output (" -> no roots declared");
else else
List := Roots.Values; List := Roots.Values;
...@@ -2596,7 +2600,7 @@ package body Makeutl is ...@@ -2596,7 +2600,7 @@ package body Makeutl is
Initialize_Source_Record (Other_Part (Root_Source)); Initialize_Source_Record (Other_Part (Root_Source));
end if; end if;
-- Save the root for the binder. -- Save the root for the binder
Source.Id.Roots := new Source_Roots' Source.Id.Roots := new Source_Roots'
(Root => Root_Source, (Root => Root_Source,
...@@ -2745,6 +2749,11 @@ package body Makeutl is ...@@ -2745,6 +2749,11 @@ package body Makeutl is
Unique_Compile : Boolean) Unique_Compile : Boolean)
is is
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref); procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref);
---------------
-- Do_Insert --
---------------
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref) is procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref) is
Unit_Based : constant Boolean := Unit_Based : constant Boolean :=
Unique_Compile Unique_Compile
...@@ -2775,7 +2784,7 @@ package body Makeutl is ...@@ -2775,7 +2784,7 @@ package body Makeutl is
if Is_Compilable (Source) if Is_Compilable (Source)
and then and then
(All_Projects (All_Projects
or else Is_Extending (Project, Source.Project)) or else Is_Extending (Project, Source.Project))
and then not Source.Locally_Removed and then not Source.Locally_Removed
and then Source.Replaced_By = No_Source and then Source.Replaced_By = No_Source
and then and then
...@@ -2855,25 +2864,25 @@ package body Makeutl is ...@@ -2855,25 +2864,25 @@ package body Makeutl is
and then Src_Id.Dep_Name = Afile and then Src_Id.Dep_Name = Afile
then then
case Src_Id.Kind is case Src_Id.Kind is
when Spec => when Spec =>
declare declare
Bdy : constant Prj.Source_Id := Bdy : constant Prj.Source_Id :=
Other_Part (Src_Id); Other_Part (Src_Id);
begin begin
if Bdy /= No_Source if Bdy /= No_Source
and then not Bdy.Locally_Removed and then not Bdy.Locally_Removed
then then
Src_Id := Other_Part (Src_Id); Src_Id := Other_Part (Src_Id);
end if;
end;
when Impl =>
if Is_Subunit (Src_Id) then
Src_Id := No_Source;
end if; end if;
end;
when Impl => when Sep =>
if Is_Subunit (Src_Id) then
Src_Id := No_Source; Src_Id := No_Source;
end if;
when Sep =>
Src_Id := No_Source;
end case; end case;
exit; exit;
...@@ -2899,6 +2908,7 @@ package body Makeutl is ...@@ -2899,6 +2908,7 @@ package body Makeutl is
end loop; end loop;
end loop; end loop;
end Insert_Withed_Sources_For; end Insert_Withed_Sources_For;
end Queue; end Queue;
---------- ----------
...@@ -2948,6 +2958,10 @@ package body Makeutl is ...@@ -2948,6 +2958,10 @@ package body Makeutl is
is is
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref); procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref);
----------------
-- Do_Compute --
----------------
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is
Data : constant Builder_Data_Access := Builder_Data (Tree); Data : constant Builder_Data_Access := Builder_Data (Tree);
All_Phases : constant Boolean := All_Phases : constant Boolean :=
...@@ -3008,8 +3022,8 @@ package body Makeutl is ...@@ -3008,8 +3022,8 @@ package body Makeutl is
Only_For_Lang : Name_Id := No_Name) Only_For_Lang : Name_Id := No_Name)
is is
Builder_Package : constant Package_Id := Builder_Package : constant Package_Id :=
Value_Of (Name_Builder, Main_Project.Decl.Packages, Value_Of (Name_Builder, Main_Project.Decl.Packages,
Project_Tree.Shared); Project_Tree.Shared);
Global_Compilation_Array : Array_Element_Id; Global_Compilation_Array : Array_Element_Id;
Global_Compilation_Elem : Array_Element; Global_Compilation_Elem : Array_Element;
...@@ -3029,7 +3043,7 @@ package body Makeutl is ...@@ -3029,7 +3043,7 @@ package body Makeutl is
Switches_For_Lang : Variable_Value := Nil_Variable_Value; Switches_For_Lang : Variable_Value := Nil_Variable_Value;
-- Value of Builder'Default_Switches(lang) -- Value of Builder'Default_Switches(lang)
Name : Name_Id := No_Name; -- main file index for Switches Name : Name_Id := No_Name; -- main file index for Switches
Switches_For_Main : Variable_Value := Nil_Variable_Value; Switches_For_Main : Variable_Value := Nil_Variable_Value;
-- Switches for a specific main. When there are several mains, Name is -- Switches for a specific main. When there are several mains, Name is
-- set to No_Name, and Switches_For_Main might be left with an actual -- set to No_Name, and Switches_For_Main might be left with an actual
...@@ -3052,7 +3066,6 @@ package body Makeutl is ...@@ -3052,7 +3066,6 @@ package body Makeutl is
-- use this language as the switches index. -- use this language as the switches index.
if Mains.Number_Of_Mains (Project_Tree) = 0 then if Mains.Number_Of_Mains (Project_Tree) = 0 then
if Only_For_Lang = No_Name then if Only_For_Lang = No_Name then
declare declare
Language : Language_Ptr := Main_Project.Languages; Language : Language_Ptr := Main_Project.Languages;
...@@ -3079,8 +3092,8 @@ package body Makeutl is ...@@ -3079,8 +3092,8 @@ package body Makeutl is
else else
for Index in 1 .. Mains.Number_Of_Mains (Project_Tree) loop for Index in 1 .. Mains.Number_Of_Mains (Project_Tree) loop
Source := Mains.Next_Main.Source; Source := Mains.Next_Main.Source;
if Source /= No_Source then
if Source /= No_Source then
if Switches_For_Main = Nil_Variable_Value then if Switches_For_Main = Nil_Variable_Value then
Switches_For_Main := Value_Of Switches_For_Main := Value_Of
(Name => Name_Id (Source.File), (Name => Name_Id (Source.File),
...@@ -3130,9 +3143,10 @@ package body Makeutl is ...@@ -3130,9 +3143,10 @@ package body Makeutl is
Default_Switches_Array := Default_Switches_Array :=
Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays; Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays;
while Default_Switches_Array /= No_Array and then while Default_Switches_Array /= No_Array
Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /= and then
Name_Default_Switches Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /=
Name_Default_Switches
loop loop
Default_Switches_Array := Default_Switches_Array :=
Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Next; Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Next;
...@@ -3243,8 +3257,7 @@ package body Makeutl is ...@@ -3243,8 +3257,7 @@ package body Makeutl is
declare declare
-- Add_Switch might itself be using the name_buffer, so -- Add_Switch might itself be using the name_buffer, so
-- we make a temporary here. -- we make a temporary here.
Switch : constant String := Switch : constant String := Name_Buffer (1 .. Name_Len);
Name_Buffer (1 .. Name_Len);
begin begin
Success := Add_Switch Success := Add_Switch
(Switch => Switch, (Switch => Switch,
......
gcc/ada/makeutl.ads
...@@ -336,7 +336,7 @@ package Makeutl is ...@@ -336,7 +336,7 @@ package Makeutl is
Need_Compilation : Boolean := True; Need_Compilation : Boolean := True;
Need_Binding : Boolean := True; Need_Binding : Boolean := True;
Need_Linking : Boolean := True; Need_Linking : Boolean := True;
-- Which of the compilation phases are needed for this project tree. -- Which of the compilation phases are needed for this project tree
end record; end record;
type Builder_Data_Access is access all Builder_Project_Tree_Data; type Builder_Data_Access is access all Builder_Project_Tree_Data;
...@@ -459,10 +459,10 @@ package Makeutl is ...@@ -459,10 +459,10 @@ package Makeutl is
Id : Source_Id := null; Id : Source_Id := null;
when Format_Gnatmake => when Format_Gnatmake =>
File : File_Name_Type := No_File; File : File_Name_Type := No_File;
Unit : Unit_Name_Type := No_Unit_Name; Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0; Index : Int := 0;
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
end case; end case;
end record; end record;
-- Information about files stored in the queue. The exact information -- Information about files stored in the queue. The exact information
...@@ -473,7 +473,7 @@ package Makeutl is ...@@ -473,7 +473,7 @@ package Makeutl is
procedure Initialize procedure Initialize
(Queue_Per_Obj_Dir : Boolean; (Queue_Per_Obj_Dir : Boolean;
Force : Boolean := False); Force : Boolean := False);
-- Initialize the queue. -- Initialize the queue.
-- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch: -- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
-- when True, there cannot be simultaneous compilations with the object -- when True, there cannot be simultaneous compilations with the object
......
gcc/ada/prj-conf.adb
...@@ -508,9 +508,9 @@ package body Prj.Conf is ...@@ -508,9 +508,9 @@ package body Prj.Conf is
else else
Add_Attributes Add_Attributes
(Project_Tree => Project_Tree, (Project_Tree => Project_Tree,
Conf_Decl => Conf_Pack.Decl, Conf_Decl => Conf_Pack.Decl,
User_Decl => User_Decl =>
Shared.Packages.Table (User_Pack_Id).Decl); Shared.Packages.Table (User_Pack_Id).Decl);
end if; end if;
...@@ -532,8 +532,7 @@ package body Prj.Conf is ...@@ -532,8 +532,7 @@ package body Prj.Conf is
("Recursively apply config to aggregated tree", ("Recursively apply config to aggregated tree",
List.Project.Name); List.Project.Name);
Apply_Config_File Apply_Config_File
(Config_File, (Config_File, Project_Tree => List.Tree);
Project_Tree => List.Tree);
List := List.Next; List := List.Next;
end loop; end loop;
end; end;
...@@ -1132,8 +1131,7 @@ package body Prj.Conf is ...@@ -1132,8 +1131,7 @@ package body Prj.Conf is
if Config_File_Name = "" then if Config_File_Name = "" then
if Obj_Dir_Exists then if Obj_Dir_Exists then
Args (3) := Args (3) := new String'(Obj_Dir & Auto_Cgpr);
new String'(Obj_Dir & Directory_Separator & Auto_Cgpr);
else else
declare declare
...@@ -1154,9 +1152,7 @@ package body Prj.Conf is ...@@ -1154,9 +1152,7 @@ package body Prj.Conf is
else else
-- We'll have an error message later on -- We'll have an error message later on
Args (3) := Args (3) := new String'(Obj_Dir & Auto_Cgpr);
new String'
(Obj_Dir & Directory_Separator & Auto_Cgpr);
end if; end if;
end; end;
end if; end if;
......
gcc/ada/prj-dect.adb
...@@ -23,11 +23,11 @@ ...@@ -23,11 +23,11 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Err_Vars; use Err_Vars;
with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
with GNAT.Strings;
with Err_Vars; use Err_Vars;
with Opt; use Opt; with Opt; use Opt;
with Prj.Attr; use Prj.Attr; with Prj.Attr; use Prj.Attr;
with Prj.Attr.PM; use Prj.Attr.PM; with Prj.Attr.PM; use Prj.Attr.PM;
...@@ -37,8 +37,6 @@ with Prj.Tree; use Prj.Tree; ...@@ -37,8 +37,6 @@ with Prj.Tree; use Prj.Tree;
with Snames; with Snames;
with Uintp; use Uintp; with Uintp; use Uintp;
with GNAT.Strings;
package body Prj.Dect is package body Prj.Dect is
use GNAT; use GNAT;
...@@ -58,10 +56,10 @@ package body Prj.Dect is ...@@ -58,10 +56,10 @@ package body Prj.Dect is
-- new name, so that the code does not have to check both names forever. -- new name, so that the code does not have to check both names forever.
procedure Check_Attribute_Allowed procedure Check_Attribute_Allowed
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id; Project : Project_Node_Id;
Attribute : Project_Node_Id; Attribute : Project_Node_Id;
Flags : Processing_Flags); Flags : Processing_Flags);
-- Check whether the attribute is valid in this project. -- Check whether the attribute is valid in this project.
-- In particular, depending on the type of project (qualifier), some -- In particular, depending on the type of project (qualifier), some
-- attributes might be disabled. -- attributes might be disabled.
...@@ -186,20 +184,20 @@ package body Prj.Dect is ...@@ -186,20 +184,20 @@ package body Prj.Dect is
and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
then then
case Name_Of (Attribute, In_Tree) is case Name_Of (Attribute, In_Tree) is
when Snames.Name_Specification => when Snames.Name_Specification =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec); Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
when Snames.Name_Specification_Suffix => when Snames.Name_Specification_Suffix =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix); Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
when Snames.Name_Implementation => when Snames.Name_Implementation =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body); Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
when Snames.Name_Implementation_Suffix => when Snames.Name_Implementation_Suffix =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix); Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
when others => when others =>
null; null;
end case; end case;
end if; end if;
end Rename_Obsolescent_Attributes; end Rename_Obsolescent_Attributes;
...@@ -234,10 +232,10 @@ package body Prj.Dect is ...@@ -234,10 +232,10 @@ package body Prj.Dect is
----------------------------- -----------------------------
procedure Check_Attribute_Allowed procedure Check_Attribute_Allowed
(In_Tree : Project_Node_Tree_Ref; (In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id; Project : Project_Node_Id;
Attribute : Project_Node_Id; Attribute : Project_Node_Id;
Flags : Processing_Flags) Flags : Processing_Flags)
is is
Qualif : constant Project_Qualifier := Qualif : constant Project_Qualifier :=
Project_Qualifier_Of (Project, In_Tree); Project_Qualifier_Of (Project, In_Tree);
......
gcc/ada/prj-env.adb
...@@ -272,15 +272,15 @@ package body Prj.Env is ...@@ -272,15 +272,15 @@ package body Prj.Env is
begin begin
-- Check if the directory is already in the table -- Check if the directory is already in the table
for Index in Object_Path_Table.First .. for Index in
Object_Path_Table.Last (Object_Paths) Object_Path_Table.First .. Object_Path_Table.Last (Object_Paths)
loop loop
-- If it is, remove it, and add it as the last one -- If it is, remove it, and add it as the last one
if Object_Paths.Table (Index) = Object_Dir then if Object_Paths.Table (Index) = Object_Dir then
for Index2 in Index + 1 .. for Index2 in
Object_Path_Table.Last (Object_Paths) Index + 1 .. Object_Path_Table.Last (Object_Paths)
loop loop
Object_Paths.Table (Index2 - 1) := Object_Paths.Table (Index2); Object_Paths.Table (Index2 - 1) := Object_Paths.Table (Index2);
end loop; end loop;
...@@ -422,8 +422,8 @@ package body Prj.Env is ...@@ -422,8 +422,8 @@ package body Prj.Env is
-- Check if the source directory is already in the table -- Check if the source directory is already in the table
for Index in Source_Path_Table.First .. for Index in
Source_Path_Table.Last (Source_Paths) Source_Path_Table.First .. Source_Path_Table.Last (Source_Paths)
loop loop
-- If it is already, no need to add it -- If it is already, no need to add it
...@@ -458,6 +458,7 @@ package body Prj.Env is ...@@ -458,6 +458,7 @@ package body Prj.Env is
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 5, Table_Initial => 5,
Table_Increment => 100); Table_Increment => 100);
Default_Naming : constant Naming_Id := Naming_Table.First; Default_Naming : constant Naming_Id := Naming_Table.First;
Namings : Naming_Table.Instance; Namings : Naming_Table.Instance;
-- Table storing the naming data for gnatmake/gprmake -- Table storing the naming data for gnatmake/gprmake
...@@ -779,7 +780,7 @@ package body Prj.Env is ...@@ -779,7 +780,7 @@ package body Prj.Env is
is is
File : File_Descriptor := Invalid_FD; File : File_Descriptor := Invalid_FD;
Buffer : String_Access := new String (1 .. Buffer_Initial); Buffer : String_Access := new String (1 .. Buffer_Initial);
Buffer_Last : Natural := 0; Buffer_Last : Natural := 0;
procedure Put_Name_Buffer; procedure Put_Name_Buffer;
...@@ -831,9 +832,8 @@ package body Prj.Env is ...@@ -831,9 +832,8 @@ package body Prj.Env is
if Source.Replaced_By = No_Source if Source.Replaced_By = No_Source
and then Source.Path.Name /= No_Path and then Source.Path.Name /= No_Path
and then and then (Source.Language.Config.Kind = File_Based
(Source.Language.Config.Kind = File_Based or else Source.Unit /= No_Unit_Index)
or else Source.Unit /= No_Unit_Index)
then then
if Source.Unit /= No_Unit_Index then if Source.Unit /= No_Unit_Index then
...@@ -999,12 +999,12 @@ package body Prj.Env is ...@@ -999,12 +999,12 @@ package body Prj.Env is
Main_Project_Only : Boolean := True; Main_Project_Only : Boolean := True;
Full_Path : Boolean := False) return String Full_Path : Boolean := False) return String
is is
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
The_Project : Project_Id := Project; The_Project : Project_Id := Project;
Original_Name : String := Name; Original_Name : String := Name;
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
Unit : Unit_Index; Unit : Unit_Index;
The_Original_Name : Name_Id; The_Original_Name : Name_Id;
The_Spec_Name : Name_Id; The_Spec_Name : Name_Id;
...@@ -1140,10 +1140,8 @@ package body Prj.Env is ...@@ -1140,10 +1140,8 @@ package body Prj.Env is
-- Check for spec -- Check for spec
if not Main_Project_Only if not Main_Project_Only
or else or else (Unit.File_Names (Spec) /= null
(Unit.File_Names (Spec) /= null and then Unit.File_Names (Spec).Project = The_Project)
and then Unit.File_Names (Spec).Project =
The_Project)
then then
declare declare
Current_Name : File_Name_Type; Current_Name : File_Name_Type;
...@@ -1670,7 +1668,7 @@ package body Prj.Env is ...@@ -1670,7 +1668,7 @@ package body Prj.Env is
-- For the object path, we make a distinction depending on -- For the object path, we make a distinction depending on
-- Including_Libraries. -- Including_Libraries.
if Objects_Path and Including_Libraries then if Objects_Path and then Including_Libraries then
if Project.Objects_Path_File_With_Libs = No_Path then if Project.Objects_Path_File_With_Libs = No_Path then
Object_Path_Table.Init (Object_Paths); Object_Path_Table.Init (Object_Paths);
Process_Object_Dirs := True; Process_Object_Dirs := True;
...@@ -1690,7 +1688,7 @@ package body Prj.Env is ...@@ -1690,7 +1688,7 @@ package body Prj.Env is
-- If there is something to do, set Seen to False for all projects, -- If there is something to do, set Seen to False for all projects,
-- then call the recursive procedure Add for Project. -- then call the recursive procedure Add for Project.
if Process_Source_Dirs or Process_Object_Dirs then if Process_Source_Dirs or else Process_Object_Dirs then
For_All_Projects (Project, In_Tree, Dummy); For_All_Projects (Project, In_Tree, Dummy);
end if; end if;
...@@ -1701,8 +1699,8 @@ package body Prj.Env is ...@@ -1701,8 +1699,8 @@ package body Prj.Env is
if Source_FD /= Invalid_FD then if Source_FD /= Invalid_FD then
Buffer_Last := 0; Buffer_Last := 0;
for Index in Source_Path_Table.First .. for Index in
Source_Path_Table.Last (Source_Paths) Source_Path_Table.First .. Source_Path_Table.Last (Source_Paths)
loop loop
Get_Name_String (Source_Paths.Table (Index)); Get_Name_String (Source_Paths.Table (Index));
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
...@@ -1727,8 +1725,8 @@ package body Prj.Env is ...@@ -1727,8 +1725,8 @@ package body Prj.Env is
if Object_FD /= Invalid_FD then if Object_FD /= Invalid_FD then
Buffer_Last := 0; Buffer_Last := 0;
for Index in Object_Path_Table.First .. for Index in
Object_Path_Table.Last (Object_Paths) Object_Path_Table.First .. Object_Path_Table.Last (Object_Paths)
loop loop
Get_Name_String (Object_Paths.Table (Index)); Get_Name_String (Object_Paths.Table (Index));
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
...@@ -1752,9 +1750,10 @@ package body Prj.Env is ...@@ -1752,9 +1750,10 @@ package body Prj.Env is
-- Set the env vars, if they need to be changed, and set the -- Set the env vars, if they need to be changed, and set the
-- corresponding flags. -- corresponding flags.
if Include_Path and then if Include_Path
Shared.Private_Part.Current_Source_Path_File /= and then
Project.Include_Path_File Shared.Private_Part.Current_Source_Path_File /=
Project.Include_Path_File
then then
Shared.Private_Part.Current_Source_Path_File := Shared.Private_Part.Current_Source_Path_File :=
Project.Include_Path_File; Project.Include_Path_File;
...@@ -2268,7 +2267,6 @@ package body Prj.Env is ...@@ -2268,7 +2267,6 @@ package body Prj.Env is
end if; end if;
-- No need to copy the Cache, it will be recomputed as needed -- No need to copy the Cache, it will be recomputed as needed
end Copy; end Copy;
end Prj.Env; end Prj.Env;
gcc/ada/prj-nmsc.adb
...@@ -37,7 +37,7 @@ with Snames; use Snames; ...@@ -37,7 +37,7 @@ with Snames; use Snames;
with Targparm; use Targparm; with Targparm; use Targparm;
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Directories; use Ada.Directories; with Ada.Directories; use Ada, Ada.Directories;
with Ada.Strings; use Ada.Strings; with Ada.Strings; use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
...@@ -217,8 +217,8 @@ package body Prj.Nmsc is ...@@ -217,8 +217,8 @@ package body Prj.Nmsc is
generic generic
with procedure Callback with procedure Callback
(Path : Path_Information; (Path : Path_Information;
Pattern_Index : Natural); Pattern_Index : Natural);
procedure Expand_Subdirectory_Pattern procedure Expand_Subdirectory_Pattern
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data; Data : in out Tree_Processing_Data;
...@@ -392,8 +392,8 @@ package body Prj.Nmsc is ...@@ -392,8 +392,8 @@ package body Prj.Nmsc is
-- the same value. -- the same value.
procedure Get_Directories procedure Get_Directories
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Get the object directory, the exec directory and the source directories -- Get the object directory, the exec directory and the source directories
-- of a project. -- of a project.
...@@ -636,11 +636,11 @@ package body Prj.Nmsc is ...@@ -636,11 +636,11 @@ package body Prj.Nmsc is
Locally_Removed : Boolean := False; Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location) Location : Source_Ptr := No_Location)
is is
Config : constant Language_Config := Lang_Id.Config; Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index; UData : Unit_Index;
Add_Src : Boolean; Add_Src : Boolean;
Source : Source_Id; Source : Source_Id;
Prev_Unit : Unit_Index := No_Unit_Index; Prev_Unit : Unit_Index := No_Unit_Index;
Source_To_Replace : Source_Id := No_Source; Source_To_Replace : Source_Id := No_Source;
begin begin
...@@ -665,9 +665,7 @@ package body Prj.Nmsc is ...@@ -665,9 +665,7 @@ package body Prj.Nmsc is
Source := Source_Files_Htable.Get Source := Source_Files_Htable.Get
(Data.Tree.Source_Files_HT, File_Name); (Data.Tree.Source_Files_HT, File_Name);
if Source /= No_Source if Source /= No_Source and then Source.Index = Index then
and then Source.Index = Index
then
Add_Src := False; Add_Src := False;
end if; end if;
end if; end if;
...@@ -891,9 +889,10 @@ package body Prj.Nmsc is ...@@ -891,9 +889,10 @@ package body Prj.Nmsc is
Remove_Source (Data.Tree, Source_To_Replace, Id); Remove_Source (Data.Tree, Source_To_Replace, Id);
end if; end if;
if Data.Tree.Replaced_Source_Number > 0 and then if Data.Tree.Replaced_Source_Number > 0
Replaced_Source_HTable.Get (Data.Tree.Replaced_Sources, Id.File) /= and then
No_File Replaced_Source_HTable.Get
(Data.Tree.Replaced_Sources, Id.File) /= No_File
then then
Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File); Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
Data.Tree.Replaced_Source_Number := Data.Tree.Replaced_Source_Number :=
...@@ -1023,7 +1022,7 @@ package body Prj.Nmsc is ...@@ -1023,7 +1022,7 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
Prj_Data : Project_Processing_Data; Prj_Data : Project_Processing_Data;
begin begin
...@@ -1031,7 +1030,7 @@ package body Prj.Nmsc is ...@@ -1031,7 +1030,7 @@ package body Prj.Nmsc is
Initialize (Prj_Data, Project); Initialize (Prj_Data, Project);
Check_If_Externally_Built (Project, Data); Check_If_Externally_Built (Project, Data);
if Project.Qualifier /= Aggregate then if Project.Qualifier /= Aggregate then
Get_Directories (Project, Data); Get_Directories (Project, Data);
...@@ -1043,8 +1042,8 @@ package body Prj.Nmsc is ...@@ -1043,8 +1042,8 @@ package body Prj.Nmsc is
end if; end if;
case Project.Qualifier is case Project.Qualifier is
when Dry => Check_Abstract_Project (Project, Data); when Dry => Check_Abstract_Project (Project, Data);
when others => null; when others => null;
end case; end case;
-- Check configuration. This must be done even for gnatmake (even though -- Check configuration. This must be done even for gnatmake (even though
...@@ -1125,8 +1124,8 @@ package body Prj.Nmsc is ...@@ -1125,8 +1124,8 @@ package body Prj.Nmsc is
(Project : Project_Id; (Project : Project_Id;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Shared : constant Shared_Project_Tree_Data_Access := Shared : constant Shared_Project_Tree_Data_Access :=
Data.Tree.Shared; Data.Tree.Shared;
Dot_Replacement : File_Name_Type := No_File; Dot_Replacement : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case; Casing : Casing_Type := All_Lower_Case;
...@@ -1418,8 +1417,9 @@ package body Prj.Nmsc is ...@@ -1418,8 +1417,9 @@ package body Prj.Nmsc is
Lang_Index.Config.Compiler_Driver := Lang_Index.Config.Compiler_Driver :=
File_Name_Type (Element.Value.Value); File_Name_Type (Element.Value.Value);
when Name_Required_Switches | when Name_Required_Switches
Name_Leading_Required_Switches => | Name_Leading_Required_Switches
=>
Put (Into_List => Put (Into_List =>
Lang_Index.Config. Lang_Index.Config.
Compiler_Leading_Required_Switches, Compiler_Leading_Required_Switches,
...@@ -2951,8 +2951,8 @@ package body Prj.Nmsc is ...@@ -2951,8 +2951,8 @@ package body Prj.Nmsc is
if Project.Library_Name /= No_Name then if Project.Library_Name /= No_Name then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Attr ("Library name: ", Write_Attr
Get_Name_String (Project.Library_Name)); ("Library name: ", Get_Name_String (Project.Library_Name));
end if; end if;
pragma Assert (Lib_Dir.Kind = Single); pragma Assert (Lib_Dir.Kind = Single);
...@@ -3096,7 +3096,7 @@ package body Prj.Nmsc is ...@@ -3096,7 +3096,7 @@ package body Prj.Nmsc is
Project.Library := Project.Library :=
Project.Library_Dir /= No_Path_Information Project.Library_Dir /= No_Path_Information
and then Project.Library_Name /= No_Name; and then Project.Library_Name /= No_Name;
if Project.Extends = No_Project then if Project.Extends = No_Project then
case Project.Qualifier is case Project.Qualifier is
...@@ -5178,13 +5178,13 @@ package body Prj.Nmsc is ...@@ -5178,13 +5178,13 @@ package body Prj.Nmsc is
No_Sources : constant Boolean := No_Sources : constant Boolean :=
((not Source_Files.Default ((not Source_Files.Default
and then Source_Files.Values = Nil_String) and then Source_Files.Values = Nil_String)
or else or else
(not Source_Dirs.Default (not Source_Dirs.Default
and then Source_Dirs.Values = Nil_String) and then Source_Dirs.Values = Nil_String)
or else or else
(not Languages.Default (not Languages.Default
and then Languages.Values = Nil_String)) and then Languages.Values = Nil_String))
and then Project.Extends = No_Project; and then Project.Extends = No_Project;
-- Start of processing for Get_Directories -- Start of processing for Get_Directories
...@@ -5231,9 +5231,7 @@ package body Prj.Nmsc is ...@@ -5231,9 +5231,7 @@ package body Prj.Nmsc is
Must_Exist => False, Must_Exist => False,
Externally_Built => Project.Externally_Built); Externally_Built => Project.Externally_Built);
if not Dir_Exists if not Dir_Exists and then not Project.Externally_Built then
and then not Project.Externally_Built
then
-- The object directory does not exist, report an error if the -- The object directory does not exist, report an error if the
-- project is not externally built. -- project is not externally built.
...@@ -5273,7 +5271,7 @@ package body Prj.Nmsc is ...@@ -5273,7 +5271,7 @@ package body Prj.Nmsc is
-- We set the object directory to its default -- We set the object directory to its default
Project.Exec_Directory := Project.Object_Directory; Project.Exec_Directory := Project.Object_Directory;
if Exec_Dir.Value /= Empty_String then if Exec_Dir.Value /= Empty_String then
Get_Name_String (Exec_Dir.Value); Get_Name_String (Exec_Dir.Value);
...@@ -5342,19 +5340,19 @@ package body Prj.Nmsc is ...@@ -5342,19 +5340,19 @@ package body Prj.Nmsc is
Remove_Source_Dirs := False; Remove_Source_Dirs := False;
Add_To_Or_Remove_From_Source_Dirs Add_To_Or_Remove_From_Source_Dirs
(Path => (Name => Project.Directory.Name, (Path => (Name => Project.Directory.Name,
Display_Name => Project.Directory.Display_Name), Display_Name => Project.Directory.Display_Name),
Rank => 1); Rank => 1);
else else
Remove_Source_Dirs := False; Remove_Source_Dirs := False;
Find_Source_Dirs Find_Source_Dirs
(Project => Project, (Project => Project,
Data => Data, Data => Data,
Patterns => Source_Dirs.Values, Patterns => Source_Dirs.Values,
Ignore => Ignore_Source_Sub_Dirs.Values, Ignore => Ignore_Source_Sub_Dirs.Values,
Search_For => Search_Directories, Search_For => Search_Directories,
Resolve_Links => Opt.Follow_Links_For_Dirs); Resolve_Links => Opt.Follow_Links_For_Dirs);
if Project.Source_Dirs = Nil_String if Project.Source_Dirs = Nil_String
and then Project.Qualifier = Standard and then Project.Qualifier = Standard
...@@ -5371,12 +5369,12 @@ package body Prj.Nmsc is ...@@ -5371,12 +5369,12 @@ package body Prj.Nmsc is
then then
Remove_Source_Dirs := True; Remove_Source_Dirs := True;
Find_Source_Dirs Find_Source_Dirs
(Project => Project, (Project => Project,
Data => Data, Data => Data,
Patterns => Excluded_Source_Dirs.Values, Patterns => Excluded_Source_Dirs.Values,
Ignore => Nil_String, Ignore => Nil_String,
Search_For => Search_Directories, Search_For => Search_Directories,
Resolve_Links => Opt.Follow_Links_For_Dirs); Resolve_Links => Opt.Follow_Links_For_Dirs);
end if; end if;
Debug_Output ("putting source directories in canonical cases"); Debug_Output ("putting source directories in canonical cases");
...@@ -6291,9 +6289,11 @@ package body Prj.Nmsc is ...@@ -6291,9 +6289,11 @@ package body Prj.Nmsc is
declare declare
Source_File_Path_Name : constant String := Source_File_Path_Name : constant String :=
Path_Name_Of Path_Name_Of
(File_Name_Type (Source_List_File.Value), (File_Name_Type
Project.Project.Directory.Display_Name); (Source_List_File.Value),
Project.Project.
Directory.Display_Name);
begin begin
Has_Explicit_Sources := True; Has_Explicit_Sources := True;
...@@ -7254,6 +7254,7 @@ package body Prj.Nmsc is ...@@ -7254,6 +7254,7 @@ package body Prj.Nmsc is
Source_Dir := Project.Project.Source_Dirs; Source_Dir := Project.Project.Source_Dirs;
Src_Dir_Rank := Project.Project.Source_Dir_Ranks; Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
while Source_Dir /= Nil_String loop while Source_Dir /= Nil_String loop
begin begin
Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank); Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
...@@ -7303,7 +7304,7 @@ package body Prj.Nmsc is ...@@ -7303,7 +7304,7 @@ package body Prj.Nmsc is
if not Opt.Follow_Links_For_Files if not Opt.Follow_Links_For_Files
or else Is_Regular_File or else Is_Regular_File
(Display_Source_Directory & Name (1 .. Last)) (Display_Source_Directory & Name (1 .. Last))
then then
Name_Len := Last; Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Name (1 .. Last); Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
...@@ -7459,8 +7460,8 @@ package body Prj.Nmsc is ...@@ -7459,8 +7460,8 @@ package body Prj.Nmsc is
if Source.Unit /= No_Unit_Index then if Source.Unit /= No_Unit_Index then
declare declare
Unit_Except : Unit_Exception := Unit_Except : Unit_Exception :=
Unit_Exceptions_Htable.Get Unit_Exceptions_Htable.Get
(Project.Unit_Exceptions, Source.Unit.Name); (Project.Unit_Exceptions, Source.Unit.Name);
begin begin
Unit_Except.Name := Source.Unit.Name; Unit_Except.Name := Source.Unit.Name;
...@@ -7516,7 +7517,7 @@ package body Prj.Nmsc is ...@@ -7516,7 +7517,7 @@ package body Prj.Nmsc is
procedure Check_Missing_Sources is procedure Check_Missing_Sources is
Extending : constant Boolean := Extending : constant Boolean :=
Project.Project.Extends /= No_Project; Project.Project.Extends /= No_Project;
Language : Language_Ptr; Language : Language_Ptr;
Source : Source_Id; Source : Source_Id;
Alt_Lang : Language_List; Alt_Lang : Language_List;
...@@ -7787,8 +7788,8 @@ package body Prj.Nmsc is ...@@ -7787,8 +7788,8 @@ package body Prj.Nmsc is
Id.Project := Project.Project; Id.Project := Project.Project;
Lang_Id := Project.Project.Languages; Lang_Id := Project.Project.Languages;
while Lang_Id /= No_Language_Index and then while Lang_Id /= No_Language_Index
Lang_Id.Name /= Src.Language and then Lang_Id.Name /= Src.Language
loop loop
Lang_Id := Lang_Id.Next; Lang_Id := Lang_Id.Next;
end loop; end loop;
...@@ -7802,9 +7803,9 @@ package body Prj.Nmsc is ...@@ -7802,9 +7803,9 @@ package body Prj.Nmsc is
" in source info file"); " in source info file");
end if; end if;
Id.Language := Lang_Id; Id.Language := Lang_Id;
Id.Kind := Src.Kind; Id.Kind := Src.Kind;
Id.Index := Src.Index; Id.Index := Src.Index;
Id.Path := Id.Path :=
(Path_Name_Type (Src.Display_Path_Name), (Path_Name_Type (Src.Display_Path_Name),
...@@ -7812,8 +7813,7 @@ package body Prj.Nmsc is ...@@ -7812,8 +7813,7 @@ package body Prj.Nmsc is
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Ada.Directories.Simple_Name (Directories.Simple_Name (Get_Name_String (Src.Path_Name)));
(Get_Name_String (Src.Path_Name)));
Id.File := Name_Find; Id.File := Name_Find;
Id.Next_With_File_Name := Id.Next_With_File_Name :=
...@@ -7822,16 +7822,16 @@ package body Prj.Nmsc is ...@@ -7822,16 +7822,16 @@ package body Prj.Nmsc is
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Ada.Directories.Simple_Name (Directories.Simple_Name
(Get_Name_String (Src.Display_Path_Name))); (Get_Name_String (Src.Display_Path_Name)));
Id.Display_File := Name_Find; Id.Display_File := Name_Find;
Id.Dep_Name := Dependency_Name Id.Dep_Name :=
(Id.File, Id.Language.Config.Dependency_Kind); Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind);
Id.Naming_Exception := Src.Naming_Exception; Id.Naming_Exception := Src.Naming_Exception;
Id.Object := Object_Name Id.Object :=
(Id.File, Id.Language.Config.Object_File_Suffix); Object_Name (Id.File, Id.Language.Config.Object_File_Suffix);
Id.Switches := Switches_Name (Id.File); Id.Switches := Switches_Name (Id.File);
-- Add the source id to the Unit_Sources_HT hash table, if the -- Add the source id to the Unit_Sources_HT hash table, if the
-- unit name is not null. -- unit name is not null.
...@@ -7840,7 +7840,8 @@ package body Prj.Nmsc is ...@@ -7840,7 +7840,8 @@ package body Prj.Nmsc is
declare declare
UData : Unit_Index := UData : Unit_Index :=
Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name); Units_Htable.Get
(Data.Tree.Units_HT, Src.Unit_Name);
begin begin
if UData = No_Unit_Index then if UData = No_Unit_Index then
UData := new Unit_Data; UData := new Unit_Data;
...@@ -8014,9 +8015,8 @@ package body Prj.Nmsc is ...@@ -8014,9 +8015,8 @@ package body Prj.Nmsc is
when Warning | Error => when Warning | Error =>
declare declare
Msg : constant String := Msg : constant String :=
"<there are no " & "<there are no "
Lang_Name & & Lang_Name & " sources in this project";
" sources in this project";
begin begin
Error_Msg_Warn := Data.Flags.When_No_Sources = Warning; Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
......
gcc/ada/prj-proc.adb
...@@ -462,9 +462,9 @@ package body Prj.Proc is ...@@ -462,9 +462,9 @@ package body Prj.Proc is
------------------------- -------------------------
function Get_Attribute_Index function Get_Attribute_Index
(Tree : Project_Node_Tree_Ref; (Tree : Project_Node_Tree_Ref;
Attr : Project_Node_Id; Attr : Project_Node_Id;
Index : Name_Id) return Name_Id Index : Name_Id) return Name_Id
is is
begin begin
if Index = All_Other_Names if Index = All_Other_Names
...@@ -685,8 +685,8 @@ package body Prj.Proc is ...@@ -685,8 +685,8 @@ package body Prj.Proc is
Index : Name_Id := No_Name; Index : Name_Id := No_Name;
begin begin
if Present (Term_Project) and then if Present (Term_Project)
Term_Project /= From_Project_Node and then Term_Project /= From_Project_Node
then then
-- This variable or attribute comes from another project -- This variable or attribute comes from another project
...@@ -1331,8 +1331,8 @@ package body Prj.Proc is ...@@ -1331,8 +1331,8 @@ package body Prj.Proc is
-- Should never happen -- Should never happen
Write_Line ("package """ & Get_Name_String (With_Name) & Write_Line
""" not found"); ("package """ & Get_Name_String (With_Name) & """ not found");
raise Program_Error; raise Program_Error;
else else
...@@ -1363,8 +1363,8 @@ package body Prj.Proc is ...@@ -1363,8 +1363,8 @@ package body Prj.Proc is
Env => Env, Env => Env,
Reset_Tree => Reset_Tree); Reset_Tree => Reset_Tree);
if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /= if Project_Qualifier_Of
Configuration (From_Project_Node, From_Project_Node_Tree) /= Configuration
then then
Process_Project_Tree_Phase_2 Process_Project_Tree_Phase_2
(In_Tree => In_Tree, (In_Tree => In_Tree,
...@@ -1381,17 +1381,16 @@ package body Prj.Proc is ...@@ -1381,17 +1381,16 @@ package body Prj.Proc is
------------------------------- -------------------------------
procedure Process_Declarative_Items procedure Process_Declarative_Items
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
Node_Tree : Project_Node_Tree_Ref; Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment; Env : Prj.Tree.Environment;
Pkg : Package_Id; Pkg : Package_Id;
Item : Project_Node_Id; Item : Project_Node_Id;
Child_Env : in out Prj.Tree.Environment) Child_Env : in out Prj.Tree.Environment)
is is
Shared : constant Shared_Project_Tree_Data_Access := Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
In_Tree.Shared;
procedure Check_Or_Set_Typed_Variable procedure Check_Or_Set_Typed_Variable
(Value : in out Variable_Value; (Value : in out Variable_Value;
...@@ -1459,8 +1458,8 @@ package body Prj.Proc is ...@@ -1459,8 +1458,8 @@ package body Prj.Proc is
(String_Type_Of (Declaration, Node_Tree), Node_Tree); (String_Type_Of (Declaration, Node_Tree), Node_Tree);
while Present (Current_String) while Present (Current_String)
and then String_Value_Of (Current_String, Node_Tree) /= and then
Value.Value String_Value_Of (Current_String, Node_Tree) /= Value.Value
loop loop
Current_String := Current_String :=
Next_Literal_String (Current_String, Node_Tree); Next_Literal_String (Current_String, Node_Tree);
...@@ -1548,16 +1547,17 @@ package body Prj.Proc is ...@@ -1548,16 +1547,17 @@ package body Prj.Proc is
declare declare
Project_Name : constant Name_Id := Project_Name : constant Name_Id :=
Name_Of (Project_Of_Renamed_Package, Node_Tree); Name_Of (Project_Of_Renamed_Package,
Node_Tree);
Renamed_Project : constant Project_Id := Renamed_Project : constant Project_Id :=
Imported_Or_Extended_Project_From Imported_Or_Extended_Project_From
(Project, Project_Name); (Project, Project_Name);
Renamed_Package : constant Package_Id := Renamed_Package : constant Package_Id :=
Package_From Package_From
(Renamed_Project, Shared, (Renamed_Project, Shared,
Name_Of (Current_Item, Node_Tree)); Name_Of (Current_Item, Node_Tree));
begin begin
-- For a renamed package, copy the declarations of the -- For a renamed package, copy the declarations of the
...@@ -1566,8 +1566,9 @@ package body Prj.Proc is ...@@ -1566,8 +1566,9 @@ package body Prj.Proc is
-- declaration. -- declaration.
Copy_Package_Declarations Copy_Package_Declarations
(From => Shared.Packages.Table (Renamed_Package).Decl, (From =>
To => Shared.Packages.Table (New_Pkg).Decl, Shared.Packages.Table (Renamed_Package).Decl,
To => Shared.Packages.Table (New_Pkg).Decl,
New_Loc => Location_Of (Current_Item, Node_Tree), New_Loc => Location_Of (Current_Item, Node_Tree),
Restricted => False, Restricted => False,
Shared => Shared); Shared => Shared);
...@@ -2359,8 +2360,8 @@ package body Prj.Proc is ...@@ -2359,8 +2360,8 @@ package body Prj.Proc is
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
if Current_Verbosity = High then if Current_Verbosity = High then
Debug_Decrease_Indent ("Done Process tree, phase 1, Success=" Debug_Decrease_Indent
& Success'Img); ("Done Process tree, phase 1, Success=" & Success'Img);
end if; end if;
end Process_Project_Tree_Phase_1; end Process_Project_Tree_Phase_1;
...@@ -2396,12 +2397,10 @@ package body Prj.Proc is ...@@ -2396,12 +2397,10 @@ package body Prj.Proc is
-- all virtual extending projects to object directory of main project. -- all virtual extending projects to object directory of main project.
if Project /= No_Project if Project /= No_Project
and then and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
then then
declare declare
Object_Dir : constant Path_Information := Object_Dir : constant Path_Information := Project.Object_Directory;
Project.Object_Directory;
begin begin
Prj := In_Tree.Projects; Prj := In_Tree.Projects;
...@@ -2471,10 +2470,9 @@ package body Prj.Proc is ...@@ -2471,10 +2470,9 @@ package body Prj.Proc is
Debug_Decrease_Indent ("Done Process tree, phase 2"); Debug_Decrease_Indent ("Done Process tree, phase 2");
Success := Success := Total_Errors_Detected = 0
Total_Errors_Detected = 0 and then
and then (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
end Process_Project_Tree_Phase_2; end Process_Project_Tree_Phase_2;
----------------------- -----------------------
...@@ -2489,8 +2487,7 @@ package body Prj.Proc is ...@@ -2489,8 +2487,7 @@ package body Prj.Proc is
Env : in out Prj.Tree.Environment; Env : in out Prj.Tree.Environment;
Extended_By : Project_Id) Extended_By : Project_Id)
is is
Shared : constant Shared_Project_Tree_Data_Access := Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
In_Tree.Shared;
Child_Env : Prj.Tree.Environment; Child_Env : Prj.Tree.Environment;
-- Only used for the root aggregate project (if any). This is left -- Only used for the root aggregate project (if any). This is left
...@@ -2576,9 +2573,9 @@ package body Prj.Proc is ...@@ -2576,9 +2573,9 @@ package body Prj.Proc is
--------------------------------- ---------------------------------
procedure Process_Aggregated_Projects is procedure Process_Aggregated_Projects is
List : Aggregated_Project_List; List : Aggregated_Project_List;
Loaded_Project : Prj.Tree.Project_Node_Id; Loaded_Project : Prj.Tree.Project_Node_Id;
Success : Boolean := True; Success : Boolean := True;
begin begin
if Project.Qualifier /= Aggregate then if Project.Qualifier /= Aggregate then
return; return;
...@@ -2587,10 +2584,10 @@ package body Prj.Proc is ...@@ -2587,10 +2584,10 @@ package body Prj.Proc is
Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name); Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);
Prj.Nmsc.Process_Aggregated_Projects Prj.Nmsc.Process_Aggregated_Projects
(Tree => In_Tree, (Tree => In_Tree,
Project => Project, Project => Project,
Node_Tree => From_Project_Node_Tree, Node_Tree => From_Project_Node_Tree,
Flags => Env.Flags); Flags => Env.Flags);
List := Project.Aggregated_Projects; List := Project.Aggregated_Projects;
while Success and then List /= null loop while Success and then List /= null loop
...@@ -2636,6 +2633,7 @@ package body Prj.Proc is ...@@ -2636,6 +2633,7 @@ package body Prj.Proc is
Env => Env, Env => Env,
Reset_Tree => False); Reset_Tree => False);
end if; end if;
else else
Debug_Output ("Failed to parse", Name_Id (List.Path)); Debug_Output ("Failed to parse", Name_Id (List.Path));
end if; end if;
...@@ -2667,8 +2665,8 @@ package body Prj.Proc is ...@@ -2667,8 +2665,8 @@ package body Prj.Proc is
Current_Pkg := First; Current_Pkg := First;
while Current_Pkg /= No_Package while Current_Pkg /= No_Package
and then Shared.Packages.Table (Current_Pkg).Name /= and then
Element.Name Shared.Packages.Table (Current_Pkg).Name /= Element.Name
loop loop
Current_Pkg := Shared.Packages.Table (Current_Pkg).Next; Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
end loop; end loop;
...@@ -2702,9 +2700,7 @@ package body Prj.Proc is ...@@ -2702,9 +2700,7 @@ package body Prj.Proc is
Attribute1 := Attr_Value1.Next; Attribute1 := Attr_Value1.Next;
end loop; end loop;
if Attribute1 = No_Variable if Attribute1 = No_Variable or else Attr_Value1.Value.Default then
or else Attr_Value1.Value.Default
then
-- Attribute Languages is not declared in the extending project. -- Attribute Languages is not declared in the extending project.
-- Check if it is declared in the project being extended. -- Check if it is declared in the project being extended.
...@@ -2715,8 +2711,8 @@ package body Prj.Proc is ...@@ -2715,8 +2711,8 @@ package body Prj.Proc is
Attribute2 := Attr_Value2.Next; Attribute2 := Attr_Value2.Next;
end loop; end loop;
if Attribute2 /= No_Variable and then if Attribute2 /= No_Variable
not Attr_Value2.Value.Default and then not Attr_Value2.Value.Default
then then
-- As attribute Languages is declared in the project being -- As attribute Languages is declared in the project being
-- extended, copy its value for the extending project. -- extended, copy its value for the extending project.
...@@ -2748,8 +2744,8 @@ package body Prj.Proc is ...@@ -2748,8 +2744,8 @@ package body Prj.Proc is
Imported : Project_List; Imported : Project_List;
Declaration_Node : Project_Node_Id := Empty_Node; Declaration_Node : Project_Node_Id := Empty_Node;
Name : constant Name_Id := Name : constant Name_Id :=
Name_Of (From_Project_Node, From_Project_Node_Tree); Name_Of (From_Project_Node, From_Project_Node_Tree);
Name_Node : constant Tree_Private_Part.Project_Name_And_Node := Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get Tree_Private_Part.Projects_Htable.Get
...@@ -2793,8 +2789,8 @@ package body Prj.Proc is ...@@ -2793,8 +2789,8 @@ package body Prj.Proc is
-- being a virtual extending project. -- being a virtual extending project.
if Name_Len > Virtual_Prefix'Length if Name_Len > Virtual_Prefix'Length
and then Name_Buffer (1 .. Virtual_Prefix'Length) = and then
Virtual_Prefix Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix
then then
Project.Virtual := True; Project.Virtual := True;
end if; end if;
...@@ -2827,9 +2823,7 @@ package body Prj.Proc is ...@@ -2827,9 +2823,7 @@ package body Prj.Proc is
Process_Imported_Projects (Imported, Limited_With => False); Process_Imported_Projects (Imported, Limited_With => False);
if Project.Qualifier = Aggregate if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
and then In_Tree.Is_Root_Tree
then
Initialize_And_Copy (Child_Env, Copy_From => Env); Initialize_And_Copy (Child_Env, Copy_From => Env);
else else
...@@ -2874,9 +2868,7 @@ package body Prj.Proc is ...@@ -2874,9 +2868,7 @@ package body Prj.Proc is
Process_Aggregated_Projects; Process_Aggregated_Projects;
end if; end if;
if Project.Qualifier = Aggregate if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
and then In_Tree.Is_Root_Tree
then
Free (Child_Env); Free (Child_Env);
end if; end if;
end; end;
......
gcc/ada/prj-tree.adb
...@@ -104,7 +104,6 @@ package body Prj.Tree is ...@@ -104,7 +104,6 @@ package body Prj.Tree is
Zone := In_Tree.Project_Nodes.Table (To).Comments; Zone := In_Tree.Project_Nodes.Table (To).Comments;
if No (Zone) then if No (Zone) then
-- Create new N_Comment_Zones node -- Create new N_Comment_Zones node
Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
...@@ -144,9 +143,9 @@ package body Prj.Tree is ...@@ -144,9 +143,9 @@ package body Prj.Tree is
-- Create new N_Comment node -- Create new N_Comment node
if (Where = After or else Where = After_End) and then if (Where = After or else Where = After_End)
Token /= Tok_EOF and then and then Token /= Tok_EOF
Comments.Table (J).Follows_Empty_Line and then Comments.Table (J).Follows_Empty_Line
then then
Comments.Table (1 .. Comments.Last - J + 1) := Comments.Table (1 .. Comments.Last - J + 1) :=
Comments.Table (J .. Comments.Last); Comments.Table (J .. Comments.Last);
......
gcc/ada/prj-util.adb
...@@ -128,8 +128,8 @@ package body Prj.Util is ...@@ -128,8 +128,8 @@ package body Prj.Util is
--------------- ---------------
procedure Duplicate procedure Duplicate
(This : in out Name_List_Index; (This : in out Name_List_Index;
Shared : Shared_Project_Tree_Data_Access) Shared : Shared_Project_Tree_Data_Access)
is is
Old_Current : Name_List_Index; Old_Current : Name_List_Index;
New_Current : Name_List_Index; New_Current : Name_List_Index;
......
gcc/ada/prj.adb
...@@ -358,7 +358,6 @@ package body Prj is ...@@ -358,7 +358,6 @@ package body Prj is
Name_Len := Name_Len - 1; Name_Len := Name_Len - 1;
return Name_Find; return Name_Find;
end Extend_Name; end Extend_Name;
--------------------- ---------------------
...@@ -377,7 +376,7 @@ package body Prj is ...@@ -377,7 +376,7 @@ package body Prj is
procedure Language_Changed (Iter : in out Source_Iterator) is procedure Language_Changed (Iter : in out Source_Iterator) is
begin begin
Iter.Current := No_Source; Iter.Current := No_Source;
if Iter.Language_Name /= No_Name then if Iter.Language_Name /= No_Name then
while Iter.Language /= null while Iter.Language /= null
...@@ -580,6 +579,7 @@ package body Prj is ...@@ -580,6 +579,7 @@ package body Prj is
begin begin
Iterator := For_Each_Source (In_Tree => Tree, Project => Proj); Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
while Element (Iterator) /= No_Source loop while Element (Iterator) /= No_Source loop
if Element (Iterator).File = Base_Name if Element (Iterator).File = Base_Name
and then (Index = 0 or else Element (Iterator).Index = Index) and then (Index = 0 or else Element (Iterator).Index = Index)
...@@ -626,6 +626,7 @@ package body Prj is ...@@ -626,6 +626,7 @@ package body Prj is
Include_Aggregated => False, Include_Aggregated => False,
With_State => Result); With_State => Result);
end if; end if;
else else
Look_For_Sources (No_Project, In_Tree, Result); Look_For_Sources (No_Project, In_Tree, Result);
end if; end if;
...@@ -1363,8 +1364,8 @@ package body Prj is ...@@ -1363,8 +1364,8 @@ package body Prj is
procedure For_All_Projects is procedure For_All_Projects is
new For_Every_Project_Imported (Boolean, Recursive_Add); new For_Every_Project_Imported (Boolean, Recursive_Add);
Dummy : Boolean := False; Dummy : Boolean := False;
List : Project_List; List : Project_List;
begin begin
List := Local_Tree.Projects; List := Local_Tree.Projects;
......
gcc/ada/sem_ch5.adb
...@@ -2263,6 +2263,8 @@ package body Sem_Ch5 is ...@@ -2263,6 +2263,8 @@ package body Sem_Ch5 is
-- If domain of iteration is an expression, create a declaration for it, -- If domain of iteration is an expression, create a declaration for it,
-- so that finalization actions are introduced outside of the loop. -- so that finalization actions are introduced outside of the loop.
-- The declaration must be a renaming because the body of the loop may
-- assign to elements.
if not Is_Entity_Name (Iter_Name) then if not Is_Entity_Name (Iter_Name) then
declare declare
...@@ -2273,10 +2275,10 @@ package body Sem_Ch5 is ...@@ -2273,10 +2275,10 @@ package body Sem_Ch5 is
Typ := Etype (Iter_Name); Typ := Etype (Iter_Name);
Decl := Decl :=
Make_Object_Declaration (Loc, Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id, Defining_Identifier => Id,
Object_Definition => New_Occurrence_Of (Typ, Loc), Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (Iter_Name)); Name => Relocate_Node (Iter_Name));
Insert_Actions (Parent (Parent (N)), New_List (Decl)); Insert_Actions (Parent (Parent (N)), New_List (Decl));
Rewrite (Name (N), New_Occurrence_Of (Id, Loc)); Rewrite (Name (N), New_Occurrence_Of (Id, Loc));
......
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