OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2011-09-02 11:03:06 +02:00
parent da6feecef6
commit 86828d402f
12 changed files with 306 additions and 294 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -1,3 +1,16 @@
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>
* s-rident.ads: Add new restriction No_Implicit_Aliasing

67
gcc/ada/makeutl.adb
View File

@ -850,9 +850,7 @@ package body Makeutl is
Allow_Wildcards => True);
end if;
if Value = Nil_Variable_Value
and then Test_Without_Suffix
then
if Value = Nil_Variable_Value and then Test_Without_Suffix then
Lang :=
Get_Language_From_Name (Project, Get_Name_String (Source_Lang));
@ -872,8 +870,8 @@ package body Makeutl is
Name (1 .. Last) := SF_Name;
if Last > Body_Suffix'Length
and then Name (Last - Body_Suffix'Length + 1 .. Last) =
Body_Suffix
and then
Name (Last - Body_Suffix'Length + 1 .. Last) = Body_Suffix
then
Truncated := True;
Last := Last - Body_Suffix'Length;
@ -881,8 +879,8 @@ package body Makeutl is
if not Truncated
and then Last > Spec_Suffix'Length
and then Name (Last - Spec_Suffix'Length + 1 .. Last) =
Spec_Suffix
and then
Name (Last - Spec_Suffix'Length + 1 .. Last) = Spec_Suffix
then
Truncated := True;
Last := Last - Spec_Suffix'Length;
@ -900,9 +898,7 @@ package body Makeutl is
Allow_Wildcards => True);
end if;
if Value = Nil_Variable_Value
and then Check_ALI_Suffix
then
if Value = Nil_Variable_Value and then Check_ALI_Suffix then
Last := SF_Name'Length;
while Name (Last) /= '.' loop
Last := Last - 1;
@ -994,8 +990,11 @@ package body Makeutl is
------------------------------
procedure Initialize_Source_Record (Source : Prj.Source_Id) is
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);
-- Update information about object file, switches file,...
@ -1004,7 +1003,9 @@ package body Makeutl is
------------------------
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
begin
Source.Object_Project := Obj_Proj;
@ -1032,7 +1033,8 @@ package body Makeutl is
declare
Switches_Path : constant String :=
Normalize_Pathname
(Name => Get_Name_String (Source.Switches),
(Name =>
Get_Name_String (Source.Switches),
Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Obj_Dir);
begin
@ -1093,17 +1095,18 @@ package body Makeutl is
-- elsewhere that's where we'll expect to find it).
Obj_Proj := Source.Project;
while Obj_Proj /= No_Project loop
declare
Dir : constant String := Get_Name_String
Dir : constant String :=
Get_Name_String
(Obj_Proj.Object_Directory.Display_Name);
Object_Path : constant String :=
Normalize_Pathname
(Name =>
Get_Name_String (Source.Object),
Resolve_Links =>
Opt.Follow_Links_For_Files,
Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Dir);
Obj_Path : constant Path_Name_Type := Create_Name (Object_Path);
@ -1397,12 +1400,12 @@ package body Makeutl is
procedure Add_Multi_Unit_Sources
(Tree : Project_Tree_Ref;
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
(Tree : Project_Tree_Ref;
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 --
@ -1624,8 +1627,8 @@ package body Makeutl is
if Is_Absolute
and then Source /= No_Source
and then File_Name_Type (Source.Path.Name) /=
File.File
and then
File_Name_Type (Source.Path.Name) /= File.File
then
Debug_Output
("Found a non-matching file",
@ -2192,7 +2195,7 @@ package body Makeutl is
-- processed, if it hasn't already been processed.
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 --
@ -2506,6 +2509,7 @@ package body Makeutl is
if Roots = Nil_Variable_Value then
Debug_Output (" -> no roots declared");
else
List := Roots.Values;
@ -2596,7 +2600,7 @@ package body Makeutl is
Initialize_Source_Record (Other_Part (Root_Source));
end if;
-- Save the root for the binder.
-- Save the root for the binder
Source.Id.Roots := new Source_Roots'
(Root => Root_Source,
@ -2745,6 +2749,11 @@ package body Makeutl is
Unique_Compile : Boolean)
is
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref);
---------------
-- Do_Insert --
---------------
procedure Do_Insert (Project : Project_Id; Tree : Project_Tree_Ref) is
Unit_Based : constant Boolean :=
Unique_Compile
@ -2899,6 +2908,7 @@ package body Makeutl is
end loop;
end loop;
end Insert_Withed_Sources_For;
end Queue;
----------
@ -2948,6 +2958,10 @@ package body Makeutl is
is
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref);
----------------
-- Do_Compute --
----------------
procedure Do_Compute (Project : Project_Id; Tree : Project_Tree_Ref) is
Data : constant Builder_Data_Access := Builder_Data (Tree);
All_Phases : constant Boolean :=
@ -3052,7 +3066,6 @@ package body Makeutl is
-- use this language as the switches index.
if Mains.Number_Of_Mains (Project_Tree) = 0 then
if Only_For_Lang = No_Name then
declare
Language : Language_Ptr := Main_Project.Languages;
@ -3079,8 +3092,8 @@ package body Makeutl is
else
for Index in 1 .. Mains.Number_Of_Mains (Project_Tree) loop
Source := Mains.Next_Main.Source;
if Source /= No_Source then
if Source /= No_Source then
if Switches_For_Main = Nil_Variable_Value then
Switches_For_Main := Value_Of
(Name => Name_Id (Source.File),
@ -3130,7 +3143,8 @@ package body Makeutl is
Default_Switches_Array :=
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 /=
Name_Default_Switches
loop
@ -3243,8 +3257,7 @@ package body Makeutl is
declare
-- Add_Switch might itself be using the name_buffer, so
-- we make a temporary here.
Switch : constant String :=
Name_Buffer (1 .. Name_Len);
Switch : constant String := Name_Buffer (1 .. Name_Len);
begin
Success := Add_Switch
(Switch => Switch,

2
gcc/ada/makeutl.ads
View File

@ -336,7 +336,7 @@ package Makeutl is
Need_Compilation : Boolean := True;
Need_Binding : 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;
type Builder_Data_Access is access all Builder_Project_Tree_Data;

10
gcc/ada/prj-conf.adb
View File

@ -532,8 +532,7 @@ package body Prj.Conf is
("Recursively apply config to aggregated tree",
List.Project.Name);
Apply_Config_File
(Config_File,
Project_Tree => List.Tree);
(Config_File, Project_Tree => List.Tree);
List := List.Next;
end loop;
end;
@ -1132,8 +1131,7 @@ package body Prj.Conf is
if Config_File_Name = "" then
if Obj_Dir_Exists then
Args (3) :=
new String'(Obj_Dir & Directory_Separator & Auto_Cgpr);
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
else
declare
@ -1154,9 +1152,7 @@ package body Prj.Conf is
else
-- We'll have an error message later on
Args (3) :=
new String'
(Obj_Dir & Directory_Separator & Auto_Cgpr);
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
end if;
end;
end if;

6
gcc/ada/prj-dect.adb
View File

@ -23,11 +23,11 @@
-- --
------------------------------------------------------------------------------
with Err_Vars; use Err_Vars;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
with GNAT.Strings;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Prj.Attr; use Prj.Attr;
with Prj.Attr.PM; use Prj.Attr.PM;
@ -37,8 +37,6 @@ with Prj.Tree; use Prj.Tree;
with Snames;
with Uintp; use Uintp;
with GNAT.Strings;
package body Prj.Dect is
use GNAT;

42
gcc/ada/prj-env.adb
View File

@ -272,15 +272,15 @@ package body Prj.Env is
begin
-- Check if the directory is already in the table
for Index in Object_Path_Table.First ..
Object_Path_Table.Last (Object_Paths)
for Index in
Object_Path_Table.First .. Object_Path_Table.Last (Object_Paths)
loop
-- If it is, remove it, and add it as the last one
if Object_Paths.Table (Index) = Object_Dir then
for Index2 in Index + 1 ..
Object_Path_Table.Last (Object_Paths)
for Index2 in
Index + 1 .. Object_Path_Table.Last (Object_Paths)
loop
Object_Paths.Table (Index2 - 1) := Object_Paths.Table (Index2);
end loop;
@ -422,8 +422,8 @@ package body Prj.Env is
-- Check if the source directory is already in the table
for Index in Source_Path_Table.First ..
Source_Path_Table.Last (Source_Paths)
for Index in
Source_Path_Table.First .. Source_Path_Table.Last (Source_Paths)
loop
-- If it is already, no need to add it
@ -458,6 +458,7 @@ package body Prj.Env is
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 100);
Default_Naming : constant Naming_Id := Naming_Table.First;
Namings : Naming_Table.Instance;
-- Table storing the naming data for gnatmake/gprmake
@ -831,8 +832,7 @@ package body Prj.Env is
if Source.Replaced_By = No_Source
and then Source.Path.Name /= No_Path
and then
(Source.Language.Config.Kind = File_Based
and then (Source.Language.Config.Kind = File_Based
or else Source.Unit /= No_Unit_Index)
then
if Source.Unit /= No_Unit_Index then
@ -999,11 +999,11 @@ package body Prj.Env is
Main_Project_Only : Boolean := True;
Full_Path : Boolean := False) return String
is
The_Project : Project_Id := Project;
Original_Name : String := Name;
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
The_Project : Project_Id := Project;
Original_Name : String := Name;
Unit : Unit_Index;
The_Original_Name : Name_Id;
@ -1140,10 +1140,8 @@ package body Prj.Env is
-- Check for spec
if not Main_Project_Only
or else
(Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Project =
The_Project)
or else (Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Project = The_Project)
then
declare
Current_Name : File_Name_Type;
@ -1670,7 +1668,7 @@ package body Prj.Env is
-- For the object path, we make a distinction depending on
-- 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
Object_Path_Table.Init (Object_Paths);
Process_Object_Dirs := True;
@ -1690,7 +1688,7 @@ package body Prj.Env is
-- If there is something to do, set Seen to False for all projects,
-- 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);
end if;
@ -1701,8 +1699,8 @@ package body Prj.Env is
if Source_FD /= Invalid_FD then
Buffer_Last := 0;
for Index in Source_Path_Table.First ..
Source_Path_Table.Last (Source_Paths)
for Index in
Source_Path_Table.First .. Source_Path_Table.Last (Source_Paths)
loop
Get_Name_String (Source_Paths.Table (Index));
Name_Len := Name_Len + 1;
@ -1727,8 +1725,8 @@ package body Prj.Env is
if Object_FD /= Invalid_FD then
Buffer_Last := 0;
for Index in Object_Path_Table.First ..
Object_Path_Table.Last (Object_Paths)
for Index in
Object_Path_Table.First .. Object_Path_Table.Last (Object_Paths)
loop
Get_Name_String (Object_Paths.Table (Index));
Name_Len := Name_Len + 1;
@ -1752,7 +1750,8 @@ package body Prj.Env is
-- Set the env vars, if they need to be changed, and set the
-- corresponding flags.
if Include_Path and then
if Include_Path
and then
Shared.Private_Part.Current_Source_Path_File /=
Project.Include_Path_File
then
@ -2268,7 +2267,6 @@ package body Prj.Env is
end if;
-- No need to copy the Cache, it will be recomputed as needed
end Copy;
end Prj.Env;

58
gcc/ada/prj-nmsc.adb
View File

@ -37,7 +37,7 @@ with Snames; use Snames;
with Targparm; use Targparm;
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.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
@ -665,9 +665,7 @@ package body Prj.Nmsc is
Source := Source_Files_Htable.Get
(Data.Tree.Source_Files_HT, File_Name);
if Source /= No_Source
and then Source.Index = Index
then
if Source /= No_Source and then Source.Index = Index then
Add_Src := False;
end if;
end if;
@ -891,9 +889,10 @@ package body Prj.Nmsc is
Remove_Source (Data.Tree, Source_To_Replace, Id);
end if;
if Data.Tree.Replaced_Source_Number > 0 and then
Replaced_Source_HTable.Get (Data.Tree.Replaced_Sources, Id.File) /=
No_File
if Data.Tree.Replaced_Source_Number > 0
and then
Replaced_Source_HTable.Get
(Data.Tree.Replaced_Sources, Id.File) /= No_File
then
Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
Data.Tree.Replaced_Source_Number :=
@ -1418,8 +1417,9 @@ package body Prj.Nmsc is
Lang_Index.Config.Compiler_Driver :=
File_Name_Type (Element.Value.Value);
when Name_Required_Switches |
Name_Leading_Required_Switches =>
when Name_Required_Switches
| Name_Leading_Required_Switches
=>
Put (Into_List =>
Lang_Index.Config.
Compiler_Leading_Required_Switches,
@ -2951,8 +2951,8 @@ package body Prj.Nmsc is
if Project.Library_Name /= No_Name then
if Current_Verbosity = High then
Write_Attr ("Library name: ",
Get_Name_String (Project.Library_Name));
Write_Attr
("Library name: ", Get_Name_String (Project.Library_Name));
end if;
pragma Assert (Lib_Dir.Kind = Single);
@ -5231,9 +5231,7 @@ package body Prj.Nmsc is
Must_Exist => False,
Externally_Built => Project.Externally_Built);
if not Dir_Exists
and then not Project.Externally_Built
then
if not Dir_Exists and then not Project.Externally_Built then
-- The object directory does not exist, report an error if the
-- project is not externally built.
@ -6292,8 +6290,10 @@ package body Prj.Nmsc is
declare
Source_File_Path_Name : constant String :=
Path_Name_Of
(File_Name_Type (Source_List_File.Value),
Project.Project.Directory.Display_Name);
(File_Name_Type
(Source_List_File.Value),
Project.Project.
Directory.Display_Name);
begin
Has_Explicit_Sources := True;
@ -7254,6 +7254,7 @@ package body Prj.Nmsc is
Source_Dir := Project.Project.Source_Dirs;
Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
while Source_Dir /= Nil_String loop
begin
Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
@ -7787,8 +7788,8 @@ package body Prj.Nmsc is
Id.Project := Project.Project;
Lang_Id := Project.Project.Languages;
while Lang_Id /= No_Language_Index and then
Lang_Id.Name /= Src.Language
while Lang_Id /= No_Language_Index
and then Lang_Id.Name /= Src.Language
loop
Lang_Id := Lang_Id.Next;
end loop;
@ -7812,8 +7813,7 @@ package body Prj.Nmsc is
Name_Len := 0;
Add_Str_To_Name_Buffer
(Ada.Directories.Simple_Name
(Get_Name_String (Src.Path_Name)));
(Directories.Simple_Name (Get_Name_String (Src.Path_Name)));
Id.File := Name_Find;
Id.Next_With_File_Name :=
@ -7822,15 +7822,15 @@ package body Prj.Nmsc is
Name_Len := 0;
Add_Str_To_Name_Buffer
(Ada.Directories.Simple_Name
(Directories.Simple_Name
(Get_Name_String (Src.Display_Path_Name)));
Id.Display_File := Name_Find;
Id.Dep_Name := Dependency_Name
(Id.File, Id.Language.Config.Dependency_Kind);
Id.Dep_Name :=
Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind);
Id.Naming_Exception := Src.Naming_Exception;
Id.Object := Object_Name
(Id.File, Id.Language.Config.Object_File_Suffix);
Id.Object :=
Object_Name (Id.File, Id.Language.Config.Object_File_Suffix);
Id.Switches := Switches_Name (Id.File);
-- Add the source id to the Unit_Sources_HT hash table, if the
@ -7840,7 +7840,8 @@ package body Prj.Nmsc is
declare
UData : Unit_Index :=
Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name);
Units_Htable.Get
(Data.Tree.Units_HT, Src.Unit_Name);
begin
if UData = No_Unit_Index then
UData := new Unit_Data;
@ -8014,9 +8015,8 @@ package body Prj.Nmsc is
when Warning | Error =>
declare
Msg : constant String :=
"<there are no " &
Lang_Name &
" sources in this project";
"<there are no "
& Lang_Name & " sources in this project";
begin
Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;

66
gcc/ada/prj-proc.adb
View File

@ -685,8 +685,8 @@ package body Prj.Proc is
Index : Name_Id := No_Name;
begin
if Present (Term_Project) and then
Term_Project /= From_Project_Node
if Present (Term_Project)
and then Term_Project /= From_Project_Node
then
-- This variable or attribute comes from another project
@ -1331,8 +1331,8 @@ package body Prj.Proc is
-- Should never happen
Write_Line ("package """ & Get_Name_String (With_Name) &
""" not found");
Write_Line
("package """ & Get_Name_String (With_Name) & """ not found");
raise Program_Error;
else
@ -1363,8 +1363,8 @@ package body Prj.Proc is
Env => Env,
Reset_Tree => Reset_Tree);
if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /=
Configuration
if Project_Qualifier_Of
(From_Project_Node, From_Project_Node_Tree) /= Configuration
then
Process_Project_Tree_Phase_2
(In_Tree => In_Tree,
@ -1390,8 +1390,7 @@ package body Prj.Proc is
Item : Project_Node_Id;
Child_Env : in out Prj.Tree.Environment)
is
Shared : constant Shared_Project_Tree_Data_Access :=
In_Tree.Shared;
Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
procedure Check_Or_Set_Typed_Variable
(Value : in out Variable_Value;
@ -1459,8 +1458,8 @@ package body Prj.Proc is
(String_Type_Of (Declaration, Node_Tree), Node_Tree);
while Present (Current_String)
and then String_Value_Of (Current_String, Node_Tree) /=
Value.Value
and then
String_Value_Of (Current_String, Node_Tree) /= Value.Value
loop
Current_String :=
Next_Literal_String (Current_String, Node_Tree);
@ -1548,7 +1547,8 @@ package body Prj.Proc is
declare
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 :=
Imported_Or_Extended_Project_From
@ -1566,7 +1566,8 @@ package body Prj.Proc is
-- declaration.
Copy_Package_Declarations
(From => Shared.Packages.Table (Renamed_Package).Decl,
(From =>
Shared.Packages.Table (Renamed_Package).Decl,
To => Shared.Packages.Table (New_Pkg).Decl,
New_Loc => Location_Of (Current_Item, Node_Tree),
Restricted => False,
@ -2359,8 +2360,8 @@ package body Prj.Proc is
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
if Current_Verbosity = High then
Debug_Decrease_Indent ("Done Process tree, phase 1, Success="
& Success'Img);
Debug_Decrease_Indent
("Done Process tree, phase 1, Success=" & Success'Img);
end if;
end Process_Project_Tree_Phase_1;
@ -2396,12 +2397,10 @@ package body Prj.Proc is
-- all virtual extending projects to object directory of main project.
if Project /= No_Project
and then
Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
then
declare
Object_Dir : constant Path_Information :=
Project.Object_Directory;
Object_Dir : constant Path_Information := Project.Object_Directory;
begin
Prj := In_Tree.Projects;
@ -2471,8 +2470,7 @@ package body Prj.Proc is
Debug_Decrease_Indent ("Done Process tree, phase 2");
Success :=
Total_Errors_Detected = 0
Success := Total_Errors_Detected = 0
and then
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
end Process_Project_Tree_Phase_2;
@ -2489,8 +2487,7 @@ package body Prj.Proc is
Env : in out Prj.Tree.Environment;
Extended_By : Project_Id)
is
Shared : constant Shared_Project_Tree_Data_Access :=
In_Tree.Shared;
Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
Child_Env : Prj.Tree.Environment;
-- Only used for the root aggregate project (if any). This is left
@ -2636,6 +2633,7 @@ package body Prj.Proc is
Env => Env,
Reset_Tree => False);
end if;
else
Debug_Output ("Failed to parse", Name_Id (List.Path));
end if;
@ -2667,8 +2665,8 @@ package body Prj.Proc is
Current_Pkg := First;
while Current_Pkg /= No_Package
and then Shared.Packages.Table (Current_Pkg).Name /=
Element.Name
and then
Shared.Packages.Table (Current_Pkg).Name /= Element.Name
loop
Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
end loop;
@ -2702,9 +2700,7 @@ package body Prj.Proc is
Attribute1 := Attr_Value1.Next;
end loop;
if Attribute1 = No_Variable
or else Attr_Value1.Value.Default
then
if Attribute1 = No_Variable or else Attr_Value1.Value.Default then
-- Attribute Languages is not declared in the extending project.
-- Check if it is declared in the project being extended.
@ -2715,8 +2711,8 @@ package body Prj.Proc is
Attribute2 := Attr_Value2.Next;
end loop;
if Attribute2 /= No_Variable and then
not Attr_Value2.Value.Default
if Attribute2 /= No_Variable
and then not Attr_Value2.Value.Default
then
-- As attribute Languages is declared in the project being
-- extended, copy its value for the extending project.
@ -2793,8 +2789,8 @@ package body Prj.Proc is
-- being a virtual extending project.
if Name_Len > Virtual_Prefix'Length
and then Name_Buffer (1 .. Virtual_Prefix'Length) =
Virtual_Prefix
and then
Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix
then
Project.Virtual := True;
end if;
@ -2827,9 +2823,7 @@ package body Prj.Proc is
Process_Imported_Projects (Imported, Limited_With => False);
if Project.Qualifier = Aggregate
and then In_Tree.Is_Root_Tree
then
if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
Initialize_And_Copy (Child_Env, Copy_From => Env);
else
@ -2874,9 +2868,7 @@ package body Prj.Proc is
Process_Aggregated_Projects;
end if;
if Project.Qualifier = Aggregate
and then In_Tree.Is_Root_Tree
then
if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
Free (Child_Env);
end if;
end;

7
gcc/ada/prj-tree.adb
View File

@ -104,7 +104,6 @@ package body Prj.Tree is
Zone := In_Tree.Project_Nodes.Table (To).Comments;
if No (Zone) then
-- Create new N_Comment_Zones node
Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
@ -144,9 +143,9 @@ package body Prj.Tree is
-- Create new N_Comment node
if (Where = After or else Where = After_End) and then
Token /= Tok_EOF and then
Comments.Table (J).Follows_Empty_Line
if (Where = After or else Where = After_End)
and then Token /= Tok_EOF
and then Comments.Table (J).Follows_Empty_Line
then
Comments.Table (1 .. Comments.Last - J + 1) :=
Comments.Table (J .. Comments.Last);

3
gcc/ada/prj.adb
View File

@ -358,7 +358,6 @@ package body Prj is
Name_Len := Name_Len - 1;
return Name_Find;
end Extend_Name;
---------------------
@ -580,6 +579,7 @@ package body Prj is
begin
Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
while Element (Iterator) /= No_Source loop
if Element (Iterator).File = Base_Name
and then (Index = 0 or else Element (Iterator).Index = Index)
@ -626,6 +626,7 @@ package body Prj is
Include_Aggregated => False,
With_State => Result);
end if;
else
Look_For_Sources (No_Project, In_Tree, Result);
end if;

8
gcc/ada/sem_ch5.adb
View File

@ -2263,6 +2263,8 @@ package body Sem_Ch5 is
-- If domain of iteration is an expression, create a declaration for it,
-- 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
declare
@ -2273,10 +2275,10 @@ package body Sem_Ch5 is
Typ := Etype (Iter_Name);
Decl :=
Make_Object_Declaration (Loc,
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id,
Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression => Relocate_Node (Iter_Name));
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name => Relocate_Node (Iter_Name));
Insert_Actions (Parent (Parent (N)), New_List (Decl));
Rewrite (Name (N), New_Occurrence_Of (Id, Loc));