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 147 additions and 135 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,8 +990,11 @@ package body Makeutl is ...@@ -994,8 +990,11 @@ 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;
Obj_Proj : Project_Id;
Obj_Path : Path_Name_Type;
Stamp : Time_Stamp_Type); Stamp : Time_Stamp_Type);
-- Update information about object file, switches file,... -- Update information about object file, switches file,...
...@@ -1004,7 +1003,9 @@ package body Makeutl is ...@@ -1004,7 +1003,9 @@ 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;
Obj_Proj : Project_Id;
Obj_Path : Path_Name_Type;
Stamp : Time_Stamp_Type) is Stamp : Time_Stamp_Type) is
begin begin
Source.Object_Project := Obj_Proj; Source.Object_Project := Obj_Proj;
...@@ -1032,7 +1033,8 @@ package body Makeutl is ...@@ -1032,7 +1033,8 @@ 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 =>
Get_Name_String (Source.Switches),
Resolve_Links => Opt.Follow_Links_For_Files, Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Obj_Dir); Directory => Obj_Dir);
begin begin
...@@ -1093,17 +1095,18 @@ package body Makeutl is ...@@ -1093,17 +1095,18 @@ 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 :=
Get_Name_String
(Obj_Proj.Object_Directory.Display_Name); (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);
...@@ -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 --
...@@ -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
...@@ -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 :=
...@@ -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,7 +3143,8 @@ package body Makeutl is ...@@ -3130,7 +3143,8 @@ 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
and then
Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /= Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /=
Name_Default_Switches Name_Default_Switches
loop loop
...@@ -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;
......
gcc/ada/prj-conf.adb
...@@ -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;
......
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
...@@ -831,8 +832,7 @@ package body Prj.Env is ...@@ -831,8 +832,7 @@ 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,11 +999,11 @@ package body Prj.Env is ...@@ -999,11 +999,11 @@ 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
The_Project : Project_Id := Project;
Original_Name : String := Name;
Lang : constant Language_Ptr := Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada"); Get_Language_From_Name (Project, "ada");
The_Project : Project_Id := Project;
Original_Name : String := Name;
Unit : Unit_Index; Unit : Unit_Index;
The_Original_Name : Name_Id; The_Original_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,7 +1750,8 @@ package body Prj.Env is ...@@ -1752,7 +1750,8 @@ 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
and then
Shared.Private_Part.Current_Source_Path_File /= Shared.Private_Part.Current_Source_Path_File /=
Project.Include_Path_File Project.Include_Path_File
then then
...@@ -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;
...@@ -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 :=
...@@ -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);
...@@ -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.
...@@ -6292,8 +6290,10 @@ package body Prj.Nmsc is ...@@ -6292,8 +6290,10 @@ 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);
...@@ -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;
...@@ -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,15 +7822,15 @@ package body Prj.Nmsc is ...@@ -7822,15 +7822,15 @@ 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
...@@ -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
...@@ -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,
...@@ -1390,8 +1390,7 @@ package body Prj.Proc is ...@@ -1390,8 +1390,7 @@ package body Prj.Proc is
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,7 +1547,8 @@ package body Prj.Proc is ...@@ -1548,7 +1547,8 @@ 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
...@@ -1566,7 +1566,8 @@ package body Prj.Proc is ...@@ -1566,7 +1566,8 @@ package body Prj.Proc is
-- declaration. -- declaration.
Copy_Package_Declarations Copy_Package_Declarations
(From => Shared.Packages.Table (Renamed_Package).Decl, (From =>
Shared.Packages.Table (Renamed_Package).Decl,
To => Shared.Packages.Table (New_Pkg).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,
...@@ -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,8 +2470,7 @@ package body Prj.Proc is ...@@ -2471,8 +2470,7 @@ 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
...@@ -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.
...@@ -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.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;
--------------------- ---------------------
...@@ -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;
......
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