+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
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));
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;
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;
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;
------------------------------
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,...
------------------------
------------------------
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;
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);
-- 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.
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);
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 --
-----------------------------
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;
Suffix : File_Name_Type;
begin
- Source := No_Source;
+ Source := No_Source;
Iter := For_Each_Source (Tree); -- In all projects
loop
Source := Prj.Element (Iter);
-- 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
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",
-- 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 --
if Roots = Nil_Variable_Value then
Debug_Output (" -> no roots declared");
+
else
List := Roots.Values;
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,
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
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
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;
end loop;
end loop;
end Insert_Withed_Sources_For;
+
end Queue;
----------
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 :=
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;
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
-- 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;
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),
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;
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,
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;
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
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
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;
("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;
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
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;
-- --
------------------------------------------------------------------------------
-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;
with Snames;
with Uintp; use Uintp;
-with GNAT.Strings;
-
package body Prj.Dect is
use GNAT;
-- 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.
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;
-----------------------------
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);
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;
-- 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
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
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;
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
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;
-- 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;
-- 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;
-- 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;
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;
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;
-- 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;
end if;
-- No need to copy the Cache, it will be recomputed as needed
-
end Copy;
end Prj.Env;
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;
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;
-- 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.
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
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;
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 :=
(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
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);
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
(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;
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,
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);
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
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
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.
-- 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);
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
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");
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;
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);
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);
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;
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;
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;
" 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),
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 :=
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.
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;
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;
-------------------------
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
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
-- 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
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,
-------------------------------
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;
(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);
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
-- 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);
(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;
-- 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;
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;
-----------------------
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
---------------------------------
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;
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
Env => Env,
Reset_Tree => False);
end if;
+
else
Debug_Output ("Failed to parse", Name_Id (List.Path));
end if;
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;
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.
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.
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
-- 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;
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
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;
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);
-- 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);
---------------
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;
Name_Len := Name_Len - 1;
return Name_Find;
-
end Extend_Name;
---------------------
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
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)
Include_Aggregated => False,
With_State => Result);
end if;
+
else
Look_For_Sources (No_Project, In_Tree, Result);
end if;
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;
-- 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
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));
projects / thirdparty / gcc.git / commitdiff
