Commit 86828d40 by Arnaud Charlet

[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
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
......
......@@ -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,9 +990,12 @@ 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;
Stamp : Time_Stamp_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,8 +1003,10 @@ package body Makeutl is
------------------------
procedure Set_Object_Project
(Obj_Dir : String; Obj_Proj : Project_Id; Obj_Path : Path_Name_Type;
Stamp : Time_Stamp_Type) is
(Obj_Dir : String;
Obj_Proj : Project_Id;
Obj_Path : Path_Name_Type;
Stamp : Time_Stamp_Type) is
begin
Source.Object_Project := Obj_Proj;
Source.Object_Path := Obj_Path;
......@@ -1031,10 +1032,11 @@ package body Makeutl is
declare
Switches_Path : constant String :=
Normalize_Pathname
(Name => Get_Name_String (Source.Switches),
Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Obj_Dir);
Normalize_Pathname
(Name =>
Get_Name_String (Source.Switches),
Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Obj_Dir);
begin
Source.Switches_Path := Create_Name (Switches_Path);
......@@ -1093,21 +1095,22 @@ 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
(Obj_Proj.Object_Directory.Display_Name);
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,
Directory => Dir);
Object_Path : constant String :=
Normalize_Pathname
(Name =>
Get_Name_String (Source.Object),
Resolve_Links => Opt.Follow_Links_For_Files,
Directory => Dir);
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
-- For specs, we do not check object files if there is a body.
......@@ -1286,10 +1289,10 @@ package body Makeutl is
for Index in reverse 1 .. Linker_Opts.Last loop
declare
Options : String_List_Id;
Proj : constant Project_Id :=
Linker_Opts.Table (Index).Project;
Option : Name_Id;
Options : String_List_Id;
Proj : constant Project_Id :=
Linker_Opts.Table (Index).Project;
Option : Name_Id;
Dir_Path : constant String :=
Get_Name_String (Proj.Directory.Name);
......@@ -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.
(Tree : Project_Tree_Ref;
Base_Main : String) return Prj.Source_Id;
-- Search for Main in the project, adding body or spec extensions
----------------------------
-- Add_Multi_Unit_Sources --
......@@ -1455,8 +1458,8 @@ package body Makeutl is
-----------------------------
function Find_File_Add_Extension
(Tree : Project_Tree_Ref;
Base_Main : String) return Prj.Source_Id
(Tree : Project_Tree_Ref;
Base_Main : String) return Prj.Source_Id
is
Spec_Source : Prj.Source_Id := No_Source;
Source : Prj.Source_Id;
......@@ -1464,7 +1467,7 @@ package body Makeutl is
Suffix : File_Name_Type;
begin
Source := No_Source;
Source := No_Source;
Iter := For_Each_Source (Tree); -- In all projects
loop
Source := Prj.Element (Iter);
......@@ -1611,10 +1614,10 @@ package body Makeutl is
-- check later that we found the correct file.
Source := Find_Source
(In_Tree => File.Tree,
Project => File.Project,
Base_Name => Main_Id,
Index => File.Index,
(In_Tree => File.Tree,
Project => File.Project,
Base_Name => Main_Id,
Index => File.Index,
In_Imported_Only => True);
if Source = No_Source then
......@@ -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
......@@ -2775,7 +2784,7 @@ package body Makeutl is
if Is_Compilable (Source)
and then
(All_Projects
or else Is_Extending (Project, Source.Project))
or else Is_Extending (Project, Source.Project))
and then not Source.Locally_Removed
and then Source.Replaced_By = No_Source
and then
......@@ -2855,25 +2864,25 @@ package body Makeutl is
and then Src_Id.Dep_Name = Afile
then
case Src_Id.Kind is
when Spec =>
declare
Bdy : constant Prj.Source_Id :=
Other_Part (Src_Id);
begin
if Bdy /= No_Source
and then not Bdy.Locally_Removed
then
Src_Id := Other_Part (Src_Id);
when Spec =>
declare
Bdy : constant Prj.Source_Id :=
Other_Part (Src_Id);
begin
if Bdy /= No_Source
and then not Bdy.Locally_Removed
then
Src_Id := Other_Part (Src_Id);
end if;
end;
when Impl =>
if Is_Subunit (Src_Id) then
Src_Id := No_Source;
end if;
end;
when Impl =>
if Is_Subunit (Src_Id) then
when Sep =>
Src_Id := No_Source;
end if;
when Sep =>
Src_Id := No_Source;
end case;
exit;
......@@ -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 :=
......@@ -3008,8 +3022,8 @@ package body Makeutl is
Only_For_Lang : Name_Id := No_Name)
is
Builder_Package : constant Package_Id :=
Value_Of (Name_Builder, Main_Project.Decl.Packages,
Project_Tree.Shared);
Value_Of (Name_Builder, Main_Project.Decl.Packages,
Project_Tree.Shared);
Global_Compilation_Array : Array_Element_Id;
Global_Compilation_Elem : Array_Element;
......@@ -3029,7 +3043,7 @@ package body Makeutl is
Switches_For_Lang : Variable_Value := Nil_Variable_Value;
-- 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 a specific main. When there are several mains, Name is
-- set to No_Name, and Switches_For_Main might be left with an actual
......@@ -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,9 +3143,10 @@ package body Makeutl is
Default_Switches_Array :=
Project_Tree.Shared.Packages.Table (Builder_Package).Decl.Arrays;
while Default_Switches_Array /= No_Array and then
Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /=
Name_Default_Switches
while Default_Switches_Array /= No_Array
and then
Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Name /=
Name_Default_Switches
loop
Default_Switches_Array :=
Project_Tree.Shared.Arrays.Table (Default_Switches_Array).Next;
......@@ -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,
......
......@@ -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;
......@@ -459,10 +459,10 @@ package Makeutl is
Id : Source_Id := null;
when Format_Gnatmake =>
File : File_Name_Type := No_File;
Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0;
Project : Project_Id := No_Project;
File : File_Name_Type := No_File;
Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0;
Project : Project_Id := No_Project;
end case;
end record;
-- Information about files stored in the queue. The exact information
......@@ -473,7 +473,7 @@ package Makeutl is
procedure Initialize
(Queue_Per_Obj_Dir : Boolean;
Force : Boolean := False);
Force : Boolean := False);
-- Initialize the queue.
-- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
-- when True, there cannot be simultaneous compilations with the object
......
......@@ -508,9 +508,9 @@ package body Prj.Conf is
else
Add_Attributes
(Project_Tree => Project_Tree,
Conf_Decl => Conf_Pack.Decl,
User_Decl =>
(Project_Tree => Project_Tree,
Conf_Decl => Conf_Pack.Decl,
User_Decl =>
Shared.Packages.Table (User_Pack_Id).Decl);
end if;
......@@ -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;
......
......@@ -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;
......@@ -58,10 +56,10 @@ package body Prj.Dect is
-- new name, so that the code does not have to check both names forever.
procedure Check_Attribute_Allowed
(In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id;
Attribute : Project_Node_Id;
Flags : Processing_Flags);
(In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id;
Attribute : Project_Node_Id;
Flags : Processing_Flags);
-- Check whether the attribute is valid in this project.
-- In particular, depending on the type of project (qualifier), some
-- attributes might be disabled.
......@@ -186,20 +184,20 @@ package body Prj.Dect is
and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
then
case Name_Of (Attribute, In_Tree) is
when Snames.Name_Specification =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
when Snames.Name_Specification =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
when Snames.Name_Specification_Suffix =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
when Snames.Name_Specification_Suffix =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
when Snames.Name_Implementation =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
when Snames.Name_Implementation =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
when Snames.Name_Implementation_Suffix =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
when Snames.Name_Implementation_Suffix =>
Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
when others =>
null;
when others =>
null;
end case;
end if;
end Rename_Obsolescent_Attributes;
......@@ -234,10 +232,10 @@ package body Prj.Dect is
-----------------------------
procedure Check_Attribute_Allowed
(In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id;
Attribute : Project_Node_Id;
Flags : Processing_Flags)
(In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id;
Attribute : Project_Node_Id;
Flags : Processing_Flags)
is
Qualif : constant Project_Qualifier :=
Project_Qualifier_Of (Project, In_Tree);
......
......@@ -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
......@@ -779,7 +780,7 @@ package body Prj.Env is
is
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;
procedure Put_Name_Buffer;
......@@ -831,9 +832,8 @@ 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
or else Source.Unit /= No_Unit_Index)
and then (Source.Language.Config.Kind = File_Based
or else Source.Unit /= No_Unit_Index)
then
if Source.Unit /= No_Unit_Index then
......@@ -999,12 +999,12 @@ package body Prj.Env is
Main_Project_Only : Boolean := True;
Full_Path : Boolean := False) return String
is
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
The_Project : Project_Id := Project;
Original_Name : String := Name;
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
Unit : Unit_Index;
The_Original_Name : Name_Id;
The_Spec_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,9 +1750,10 @@ 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
Shared.Private_Part.Current_Source_Path_File /=
Project.Include_Path_File
if Include_Path
and then
Shared.Private_Part.Current_Source_Path_File /=
Project.Include_Path_File
then
Shared.Private_Part.Current_Source_Path_File :=
Project.Include_Path_File;
......@@ -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;
......@@ -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;
......@@ -217,8 +217,8 @@ package body Prj.Nmsc is
generic
with procedure Callback
(Path : Path_Information;
Pattern_Index : Natural);
(Path : Path_Information;
Pattern_Index : Natural);
procedure Expand_Subdirectory_Pattern
(Project : Project_Id;
Data : in out Tree_Processing_Data;
......@@ -392,8 +392,8 @@ package body Prj.Nmsc is
-- the same value.
procedure Get_Directories
(Project : Project_Id;
Data : in out Tree_Processing_Data);
(Project : Project_Id;
Data : in out Tree_Processing_Data);
-- Get the object directory, the exec directory and the source directories
-- of a project.
......@@ -636,11 +636,11 @@ package body Prj.Nmsc is
Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location)
is
Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index;
Add_Src : Boolean;
Source : Source_Id;
Prev_Unit : Unit_Index := No_Unit_Index;
Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index;
Add_Src : Boolean;
Source : Source_Id;
Prev_Unit : Unit_Index := No_Unit_Index;
Source_To_Replace : Source_Id := No_Source;
begin
......@@ -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 :=
......@@ -1023,7 +1022,7 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
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;
begin
......@@ -1031,7 +1030,7 @@ package body Prj.Nmsc is
Initialize (Prj_Data, Project);
Check_If_Externally_Built (Project, Data);
Check_If_Externally_Built (Project, Data);
if Project.Qualifier /= Aggregate then
Get_Directories (Project, Data);
......@@ -1043,8 +1042,8 @@ package body Prj.Nmsc is
end if;
case Project.Qualifier is
when Dry => Check_Abstract_Project (Project, Data);
when others => null;
when Dry => Check_Abstract_Project (Project, Data);
when others => null;
end case;
-- Check configuration. This must be done even for gnatmake (even though
......@@ -1125,8 +1124,8 @@ package body Prj.Nmsc is
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
Shared : constant Shared_Project_Tree_Data_Access :=
Data.Tree.Shared;
Shared : constant Shared_Project_Tree_Data_Access :=
Data.Tree.Shared;
Dot_Replacement : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case;
......@@ -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);
......@@ -3096,7 +3096,7 @@ package body Prj.Nmsc is
Project.Library :=
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
case Project.Qualifier is
......@@ -5178,13 +5178,13 @@ package body Prj.Nmsc is
No_Sources : constant Boolean :=
((not Source_Files.Default
and then Source_Files.Values = Nil_String)
or else
(not Source_Dirs.Default
and then Source_Dirs.Values = Nil_String)
or else
(not Languages.Default
and then Languages.Values = Nil_String))
and then Source_Files.Values = Nil_String)
or else
(not Source_Dirs.Default
and then Source_Dirs.Values = Nil_String)
or else
(not Languages.Default
and then Languages.Values = Nil_String))
and then Project.Extends = No_Project;
-- Start of processing for Get_Directories
......@@ -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.
......@@ -5273,7 +5271,7 @@ package body Prj.Nmsc is
-- 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
Get_Name_String (Exec_Dir.Value);
......@@ -5342,19 +5340,19 @@ package body Prj.Nmsc is
Remove_Source_Dirs := False;
Add_To_Or_Remove_From_Source_Dirs
(Path => (Name => Project.Directory.Name,
Display_Name => Project.Directory.Display_Name),
Rank => 1);
(Path => (Name => Project.Directory.Name,
Display_Name => Project.Directory.Display_Name),
Rank => 1);
else
Remove_Source_Dirs := False;
Find_Source_Dirs
(Project => Project,
Data => Data,
Patterns => Source_Dirs.Values,
Ignore => Ignore_Source_Sub_Dirs.Values,
Search_For => Search_Directories,
Resolve_Links => Opt.Follow_Links_For_Dirs);
(Project => Project,
Data => Data,
Patterns => Source_Dirs.Values,
Ignore => Ignore_Source_Sub_Dirs.Values,
Search_For => Search_Directories,
Resolve_Links => Opt.Follow_Links_For_Dirs);
if Project.Source_Dirs = Nil_String
and then Project.Qualifier = Standard
......@@ -5371,12 +5369,12 @@ package body Prj.Nmsc is
then
Remove_Source_Dirs := True;
Find_Source_Dirs
(Project => Project,
Data => Data,
Patterns => Excluded_Source_Dirs.Values,
Ignore => Nil_String,
Search_For => Search_Directories,
Resolve_Links => Opt.Follow_Links_For_Dirs);
(Project => Project,
Data => Data,
Patterns => Excluded_Source_Dirs.Values,
Ignore => Nil_String,
Search_For => Search_Directories,
Resolve_Links => Opt.Follow_Links_For_Dirs);
end if;
Debug_Output ("putting source directories in canonical cases");
......@@ -6291,9 +6289,11 @@ 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);
Path_Name_Of
(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);
......@@ -7303,7 +7304,7 @@ package body Prj.Nmsc is
if not Opt.Follow_Links_For_Files
or else Is_Regular_File
(Display_Source_Directory & Name (1 .. Last))
(Display_Source_Directory & Name (1 .. Last))
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
......@@ -7459,8 +7460,8 @@ package body Prj.Nmsc is
if Source.Unit /= No_Unit_Index then
declare
Unit_Except : Unit_Exception :=
Unit_Exceptions_Htable.Get
(Project.Unit_Exceptions, Source.Unit.Name);
Unit_Exceptions_Htable.Get
(Project.Unit_Exceptions, Source.Unit.Name);
begin
Unit_Except.Name := Source.Unit.Name;
......@@ -7516,7 +7517,7 @@ package body Prj.Nmsc is
procedure Check_Missing_Sources is
Extending : constant Boolean :=
Project.Project.Extends /= No_Project;
Project.Project.Extends /= No_Project;
Language : Language_Ptr;
Source : Source_Id;
Alt_Lang : Language_List;
......@@ -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;
......@@ -7802,9 +7803,9 @@ package body Prj.Nmsc is
" in source info file");
end if;
Id.Language := Lang_Id;
Id.Kind := Src.Kind;
Id.Index := Src.Index;
Id.Language := Lang_Id;
Id.Kind := Src.Kind;
Id.Index := Src.Index;
Id.Path :=
(Path_Name_Type (Src.Display_Path_Name),
......@@ -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,16 +7822,16 @@ 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.Naming_Exception := Src.Naming_Exception;
Id.Object := Object_Name
(Id.File, Id.Language.Config.Object_File_Suffix);
Id.Switches := Switches_Name (Id.File);
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.Switches := Switches_Name (Id.File);
-- Add the source id to the Unit_Sources_HT hash table, if the
-- unit name is not null.
......@@ -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;
......
......@@ -462,9 +462,9 @@ package body Prj.Proc is
-------------------------
function Get_Attribute_Index
(Tree : Project_Node_Tree_Ref;
Attr : Project_Node_Id;
Index : Name_Id) return Name_Id
(Tree : Project_Node_Tree_Ref;
Attr : Project_Node_Id;
Index : Name_Id) return Name_Id
is
begin
if Index = All_Other_Names
......@@ -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,
......@@ -1381,17 +1381,16 @@ package body Prj.Proc is
-------------------------------
procedure Process_Declarative_Items
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
From_Project_Node : Project_Node_Id;
Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
Item : Project_Node_Id;
Child_Env : in out Prj.Tree.Environment)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
From_Project_Node : Project_Node_Id;
Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
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,16 +1547,17 @@ 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
(Project, Project_Name);
Imported_Or_Extended_Project_From
(Project, Project_Name);
Renamed_Package : constant Package_Id :=
Package_From
(Renamed_Project, Shared,
Name_Of (Current_Item, Node_Tree));
Package_From
(Renamed_Project, Shared,
Name_Of (Current_Item, Node_Tree));
begin
-- For a renamed package, copy the declarations of the
......@@ -1566,8 +1566,9 @@ package body Prj.Proc is
-- declaration.
Copy_Package_Declarations
(From => Shared.Packages.Table (Renamed_Package).Decl,
To => Shared.Packages.Table (New_Pkg).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,
Shared => Shared);
......@@ -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,10 +2470,9 @@ package body Prj.Proc is
Debug_Decrease_Indent ("Done Process tree, phase 2");
Success :=
Total_Errors_Detected = 0
and then
(Warning_Mode /= Treat_As_Error or else Warnings_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
......@@ -2576,9 +2573,9 @@ package body Prj.Proc is
---------------------------------
procedure Process_Aggregated_Projects is
List : Aggregated_Project_List;
List : Aggregated_Project_List;
Loaded_Project : Prj.Tree.Project_Node_Id;
Success : Boolean := True;
Success : Boolean := True;
begin
if Project.Qualifier /= Aggregate then
return;
......@@ -2587,10 +2584,10 @@ package body Prj.Proc is
Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);
Prj.Nmsc.Process_Aggregated_Projects
(Tree => In_Tree,
Project => Project,
Node_Tree => From_Project_Node_Tree,
Flags => Env.Flags);
(Tree => In_Tree,
Project => Project,
Node_Tree => From_Project_Node_Tree,
Flags => Env.Flags);
List := Project.Aggregated_Projects;
while Success and then List /= null loop
......@@ -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.
......@@ -2748,8 +2744,8 @@ package body Prj.Proc is
Imported : Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
Name : constant Name_Id :=
Name_Of (From_Project_Node, From_Project_Node_Tree);
Name : constant Name_Id :=
Name_Of (From_Project_Node, From_Project_Node_Tree);
Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get
......@@ -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;
......
......@@ -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);
......
......@@ -128,8 +128,8 @@ package body Prj.Util is
---------------
procedure Duplicate
(This : in out Name_List_Index;
Shared : Shared_Project_Tree_Data_Access)
(This : in out Name_List_Index;
Shared : Shared_Project_Tree_Data_Access)
is
Old_Current : Name_List_Index;
New_Current : Name_List_Index;
......
......@@ -358,7 +358,6 @@ package body Prj is
Name_Len := Name_Len - 1;
return Name_Find;
end Extend_Name;
---------------------
......@@ -377,7 +376,7 @@ package body Prj is
procedure Language_Changed (Iter : in out Source_Iterator) is
begin
Iter.Current := No_Source;
Iter.Current := No_Source;
if Iter.Language_Name /= No_Name then
while Iter.Language /= null
......@@ -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;
......@@ -1363,8 +1364,8 @@ package body Prj is
procedure For_All_Projects is
new For_Every_Project_Imported (Boolean, Recursive_Add);
Dummy : Boolean := False;
List : Project_List;
Dummy : Boolean := False;
List : Project_List;
begin
List := Local_Tree.Projects;
......
......@@ -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));
......
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