* exp_ch3.adb, exp_ch5.adb, exp_disp.adb, exp_dist.adb, gnatlink.adb,
makeutl.adb, par-ch6.adb, prj-dect.adb, prj-env.adb, prj-env.ads,
prj-ext.adb, prj-nmsc.adb, prj-part.adb, prj-pp.ads: Minor code
reorganization.
Minor reformatting.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164979
138bc75d-0d04-0410-961f-
82ee72b054a4
15 files changed:
+2010-10-05 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch3.adb, exp_ch5.adb, exp_disp.adb, exp_dist.adb, gnatlink.adb,
+ makeutl.adb, par-ch6.adb, prj-dect.adb, prj-env.adb, prj-env.ads,
+ prj-ext.adb, prj-nmsc.adb, prj-part.adb, prj-pp.ads: Minor code
+ reorganization.
+ Minor reformatting.
+
2010-10-05 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Check_Parameterless_Call): If the prefix of 'Address is
2010-10-05 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Check_Parameterless_Call): If the prefix of 'Address is
-- Ityp!(Displace (Temp'Address, I'Tag)).all;
else
-- Ityp!(Displace (Temp'Address, I'Tag)).all;
else
- -- Generate the equivalent record type and update
- -- the subtype indication to reference it
+ -- Generate the equivalent record type and update the
+ -- subtype indication to reference it.
Expand_Subtype_From_Expr
(N => N,
Expand_Subtype_From_Expr
(N => N,
Expression => New_Expr));
-- Dynamically reference the tag associated with the
Expression => New_Expr));
-- Dynamically reference the tag associated with the
Tag_Comp :=
Make_Function_Call (Loc,
Tag_Comp :=
Make_Function_Call (Loc,
Rewrite (N,
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Make_Temporary (Loc, 'D'),
Rewrite (N,
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Make_Temporary (Loc, 'D'),
- Subtype_Mark => New_Occurrence_Of (Typ, Loc),
+ Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name => Convert_Tag_To_Interface (Typ, Tag_Comp)));
Analyze (N, Suppress => All_Checks);
Name => Convert_Tag_To_Interface (Typ, Tag_Comp)));
Analyze (N, Suppress => All_Checks);
else
Expr :=
Make_Selected_Component (Loc,
else
Expr :=
Make_Selected_Component (Loc,
- Prefix => Duplicate_Subexpr (Rhs),
+ Prefix => Duplicate_Subexpr (Rhs),
Selector_Name => New_Occurrence_Of (C, Loc));
end if;
Selector_Name => New_Occurrence_Of (C, Loc));
end if;
Make_Assignment_Statement (Loc,
Name =>
Make_Selected_Component (Loc,
Make_Assignment_Statement (Loc,
Name =>
Make_Selected_Component (Loc,
- Prefix => Duplicate_Subexpr (Lhs),
+ Prefix => Duplicate_Subexpr (Lhs),
Selector_Name =>
New_Occurrence_Of (Find_Component (L_Typ, C), Loc)),
Expression => Expr);
Selector_Name =>
New_Occurrence_Of (Find_Component (L_Typ, C), Loc)),
Expression => Expr);
and then Is_Interface (Typ)
and then
((Nkind (Expr) = N_Selected_Component
and then Is_Interface (Typ)
and then
((Nkind (Expr) = N_Selected_Component
- and then Is_Tag (Entity (Selector_Name (Expr))))
+ and then Is_Tag (Entity (Selector_Name (Expr))))
or else
(Nkind (Expr) = N_Function_Call
or else
(Nkind (Expr) = N_Function_Call
- and then RTE_Available (RE_Displace)
- and then Entity (Name (Expr)) = RTE (RE_Displace))));
+ and then RTE_Available (RE_Displace)
+ and then Entity (Name (Expr)) = RTE (RE_Displace))));
Anon_Type := Create_Itype (E_Anonymous_Access_Type, Expr);
Set_Directly_Designated_Type (Anon_Type, Typ);
Anon_Type := Create_Itype (E_Anonymous_Access_Type, Expr);
Set_Directly_Designated_Type (Anon_Type, Typ);
Write_Int (Int (Alias (Prim)));
-- If the DTC_Entity attribute is already set we can also output
Write_Int (Int (Alias (Prim)));
-- If the DTC_Entity attribute is already set we can also output
- -- the name of the interface covered by this primitive (if any)
+ -- the name of the interface covered by this primitive (if any).
if Present (DTC_Entity (Alias (Prim)))
and then Is_Interface (Scope (DTC_Entity (Alias (Prim))))
if Present (DTC_Entity (Alias (Prim)))
and then Is_Interface (Scope (DTC_Entity (Alias (Prim))))
begin
if Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) then
null;
begin
if Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) then
null;
else
Serial := Increment_Serial_Number;
end if;
else
Serial := Increment_Serial_Number;
end if;
for J in reverse Linker_Options.First .. Linker_Options.Last loop
-- Remove flags that are not accepted
for J in reverse Linker_Options.First .. Linker_Options.Last loop
-- Remove flags that are not accepted
if Linker_Options.Table (J)'Length = 0
or else Linker_Options.Table (J) (1 .. 2) = "-l"
or else Linker_Options.Table (J) (1 .. 3) = "-Wl"
if Linker_Options.Table (J)'Length = 0
or else Linker_Options.Table (J) (1 .. 2) = "-l"
or else Linker_Options.Table (J) (1 .. 3) = "-Wl"
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Command_Line; use Ada.Command_Line;
-with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.HTable;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.HTable;
-- case is for subunits.
if Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub
-- case is for subunits.
if Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub
- and then Pf_Flags /= Pf_Decl_Pbod
- and then Pf_Flags /= Pf_Pbod
+ and then
+ Pf_Flags /= Pf_Decl_Pbod
+ and then
+ Pf_Flags /= Pf_Pbod
then
Error_Msg_SC ("overriding indicator not allowed here!");
then
Error_Msg_SC ("overriding indicator not allowed here!");
- -- Skip extra parenthesis at end of formal part, and if
- -- function scan result subtype.
+ -- Skip extra parenthesis at end of formal part
Ignore (Tok_Right_Paren);
Ignore (Tok_Right_Paren);
+ -- For function, scan result subtype
+
procedure Rename_Obsolescent_Attributes
(In_Tree : Project_Node_Tree_Ref;
Attribute : Project_Node_Id;
procedure Rename_Obsolescent_Attributes
(In_Tree : Project_Node_Tree_Ref;
Attribute : Project_Node_Id;
- Current_Package : Project_Node_Id) is
+ Current_Package : Project_Node_Id)
+ is
begin
if Present (Current_Package)
and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
begin
if Present (Current_Package)
and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
Flags : Processing_Flags)
is
Qualif : constant Project_Qualifier :=
Flags : Processing_Flags)
is
Qualif : constant Project_Qualifier :=
- Project_Qualifier_Of (Project, In_Tree);
+ Project_Qualifier_Of (Project, In_Tree);
Name : constant Name_Id := Name_Of (Current_Package, In_Tree);
begin
if Qualif = Aggregate
Name : constant Name_Id := Name_Of (Current_Package, In_Tree);
begin
if Qualif = Aggregate
Flags : Processing_Flags)
is
Qualif : constant Project_Qualifier :=
Flags : Processing_Flags)
is
Qualif : constant Project_Qualifier :=
- Project_Qualifier_Of (Project, In_Tree);
+ Project_Qualifier_Of (Project, In_Tree);
Name : constant Name_Id := Name_Of (Attribute, In_Tree);
Name : constant Name_Id := Name_Of (Attribute, In_Tree);
begin
case Qualif is
when Aggregate =>
begin
case Qualif is
when Aggregate =>
procedure Process_Attribute_Name is
Ignore : Boolean;
procedure Process_Attribute_Name is
Ignore : Boolean;
begin
Attribute_Name := Token_Name;
Set_Name_Of (Attribute, In_Tree, To => Attribute_Name);
begin
Attribute_Name := Token_Name;
Set_Name_Of (Attribute, In_Tree, To => Attribute_Name);
------------------------------------------------------------------------------
with Fmap;
------------------------------------------------------------------------------
with Fmap;
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with Makeutl; use Makeutl;
+with Makeutl; use Makeutl;
-with Osint; use Osint;
-with Output; use Output;
-with Prj.Com; use Prj.Com;
+with Osint; use Osint;
+with Output; use Output;
+with Prj.Com; use Prj.Com;
with Sdefault;
with Tempdir;
with Sdefault;
with Tempdir;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+
package body Prj.Env is
Buffer_Initial : constant := 1_000;
package body Prj.Env is
Buffer_Initial : constant := 1_000;
-- Project that itself is not extended.
procedure Initialize_Project_Path
-- Project that itself is not extended.
procedure Initialize_Project_Path
- (Self : in out Project_Search_Path; Target_Name : String);
- -- Initialize Current_Project_Path.
- -- Does nothing if the path has already been initialized properly
+ (Self : in out Project_Search_Path;
+ Target_Name : String);
+ -- Initialize Current_Project_Path. Does nothing if the path has already
+ -- been initialized properly.
----------------------
-- Ada_Include_Path --
----------------------
-- Ada_Include_Path --
-----------------------------
procedure Initialize_Project_Path
-----------------------------
procedure Initialize_Project_Path
- (Self : in out Project_Search_Path; Target_Name : String)
+ (Self : in out Project_Search_Path;
+ Target_Name : String)
is
Add_Default_Dir : Boolean := True;
First : Positive;
is
Add_Default_Dir : Boolean := True;
First : Positive;
begin
-- If already initialized, nothing else to do
begin
-- If already initialized, nothing else to do
if Self.Path /= null
and then Self.Path (Self.Path'First) /= '#'
then
if Self.Path /= null
and then Self.Path (Self.Path'First) /= '#'
then
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Iterate through all the source directories of a project, including those
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Iterate through all the source directories of a project, including those
- -- of imported or modified projects.
- -- Only returns those directories that potentially contain Ada sources (ie
- -- ignore projects that have no Ada sources
+ -- of imported or modified projects. Only returns those directories that
+ -- potentially contain Ada sources (ie ignore projects that have no Ada
+ -- sources
generic
with procedure Action (Path : String);
generic
with procedure Action (Path : String);
procedure Add_Directories
(Self : in out Project_Search_Path;
Path : String);
procedure Add_Directories
(Self : in out Project_Search_Path;
Path : String);
- -- Add one or more directories to the path.
- -- Directories added with this procedure are added in order after the
- -- current directory and before the path given by the environment variable
- -- GPR_PROJECT_PATH. A value of "-" will remove the default project
- -- directory from the project path.
+ -- Add one or more directories to the path. Directories added with this
+ -- procedure are added in order after the current directory and before the
+ -- path given by the environment variable GPR_PROJECT_PATH. A value of "-"
+ -- will remove the default project directory from the project path.
--
-- Calls to this subprogram must be performed before the first call to
-- Find_Project below, or PATH will be added at the end of the search
--
-- Calls to this subprogram must be performed before the first call to
-- Find_Project below, or PATH will be added at the end of the search
Directory : String;
Path : out Namet.Path_Name_Type);
-- Search for a the project with the given name either in Directory (which
Directory : String;
Path : out Namet.Path_Name_Type);
-- Search for a the project with the given name either in Directory (which
- -- often will be the directory contain the project we are currently
- -- parsing and which we found a reference to another project), or in the
- -- project path. Extra_Project_Path contains additional directories to
- -- search.
+ -- often will be the directory contain the project we are currently parsing
+ -- and which we found a reference to another project), or in the project
+ -- path. Extra_Project_Path contains additional directories to search.
+ --
-- Project_File_Name can optionally contain directories, and the extension
-- (.gpr) for the file name is optional.
-- Project_File_Name can optionally contain directories, and the extension
-- (.gpr) for the file name is optional.
- -- Returns No_Name if no such project was found.
+ --
+ -- Returns No_Name if no such project was found
private
package Projects_Paths is new GNAT.Dynamic_HTables.Simple_HTable
private
package Projects_Paths is new GNAT.Dynamic_HTables.Simple_HTable
-- --
------------------------------------------------------------------------------
-- --
------------------------------------------------------------------------------
-with Osint; use Osint;
-with Prj.Tree; use Prj.Tree;
+with Osint; use Osint;
+with Prj.Tree; use Prj.Tree;
-- --
------------------------------------------------------------------------------
-- --
------------------------------------------------------------------------------
-with GNAT.Case_Util; use GNAT.Case_Util;
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.Dynamic_HTables;
-with GNAT.Table;
-
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Osint; use Osint;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Osint; use Osint;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
+with GNAT.Case_Util; use GNAT.Case_Util;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Dynamic_HTables;
+with GNAT.Table;
+
package body Prj.Nmsc is
No_Continuation_String : aliased String := "";
package body Prj.Nmsc is
No_Continuation_String : aliased String := "";
Languages : constant Variable_Value :=
Prj.Util.Value_Of
Languages : constant Variable_Value :=
Prj.Util.Value_Of
- (Name_Languages, Project.Decl.Attributes, Data.Tree);
+ (Name_Languages, Project.Decl.Attributes, Data.Tree);
Remove_Source_Dirs : Boolean := False;
Remove_Source_Dirs : Boolean := False;
exception
when Types.Unrecoverable_Error =>
exception
when Types.Unrecoverable_Error =>
-- Unrecoverable_Error is raised when a line is too long.
-- A meaningful error message will be displayed later.
-- Unrecoverable_Error is raised when a line is too long.
-- A meaningful error message will be displayed later.
Project := Empty_Node;
end;
Project := Empty_Node;
end;
declare
Declaration : constant Project_Node_Id :=
declare
Declaration : constant Project_Node_Id :=
- Project_Declaration_Of (Project, In_Tree);
+ Project_Declaration_Of (Project, In_Tree);
begin
Look_For_Virtual_Projects_For
(Extended_Project_Of (Declaration, In_Tree), In_Tree,
begin
Look_For_Virtual_Projects_For
(Extended_Project_Of (Declaration, In_Tree), In_Tree,
-- Now, check the projects directly imported by the main project.
-- Remove from the potentially virtual any project extended by one
-- Now, check the projects directly imported by the main project.
-- Remove from the potentially virtual any project extended by one
- -- of these imported projects. For non extending imported
- -- projects, check that they do not belong to the project tree of
- -- the project being "extended-all" by the main project.
+ -- of these imported projects. For non extending imported projects,
+ -- check that they do not belong to the project tree of the project
+ -- being "extended-all" by the main project.
declare
With_Clause : Project_Node_Id;
declare
With_Clause : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id)
is
In_Tree : Project_Node_Tree_Ref;
Project : Project_Node_Id)
is
- With_Clause, Imported : Project_Node_Id;
+ With_Clause : Project_Node_Id;
+ Imported : Project_Node_Id;
+
begin
if not Is_Extending_All (Project, In_Tree) then
With_Clause := First_With_Clause_Of (Project, In_Tree);
begin
if not Is_Extending_All (Project, In_Tree) then
With_Clause := First_With_Clause_Of (Project, In_Tree);
while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree);
while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree);
end;
if Has_Circular_Dependencies
end;
if Has_Circular_Dependencies
- (Flags, Normed_Path_Name, Canonical_Path_Name)
+ (Flags, Normed_Path_Name, Canonical_Path_Name)
then
Project := Empty_Node;
return;
then
Project := Empty_Node;
return;
Name_Len := Name_Len - 1;
end loop;
Name_Len := Name_Len - 1;
end loop;
- -- If a dot was found, check if the parent project is imported
- -- or extended.
+ -- If a dot was found, check if parent project is imported or extended
if Name_Len > 0 then
Name_Len := Name_Len - 1;
declare
if Name_Len > 0 then
Name_Len := Name_Len - 1;
declare
- Parent_Name : constant Name_Id := Name_Find;
- Parent_Found : Boolean := False;
- Parent_Node : Project_Node_Id := Empty_Node;
- With_Clause : Project_Node_Id :=
- First_With_Clause_Of (Project, In_Tree);
+ Parent_Name : constant Name_Id := Name_Find;
+ Parent_Found : Boolean := False;
+ Parent_Node : Project_Node_Id := Empty_Node;
+ With_Clause : Project_Node_Id :=
+ First_With_Clause_Of (Project, In_Tree);
Imp_Proj_Name : Name_Id;
begin
Imp_Proj_Name : Name_Id;
begin
Imported_Loop :
while not Parent_Found and then Present (With_Clause) loop
Parent_Node := Project_Node_Of (With_Clause, In_Tree);
Imported_Loop :
while not Parent_Found and then Present (With_Clause) loop
Parent_Node := Project_Node_Of (With_Clause, In_Tree);
-
- Extension_Loop :
- while Present (Parent_Node) loop
+ Extension_Loop : while Present (Parent_Node) loop
Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
Parent_Found := Imp_Proj_Name = Parent_Name;
exit Imported_Loop when Parent_Found;
Imp_Proj_Name := Name_Of (Parent_Node, In_Tree);
Parent_Found := Imp_Proj_Name = Parent_Name;
exit Imported_Loop when Parent_Found;
-- Output a project file, using either the default output routines, or the
-- ones specified by W_Char, W_Eol and W_Str.
--
-- Output a project file, using either the default output routines, or the
-- ones specified by W_Char, W_Eol and W_Str.
--
- -- Increment is the number of spaces for each indentation level.
+ -- Increment is the number of spaces for each indentation level
--
-- W_Char, W_Eol and W_Str can be used to change the default output
-- procedures. The default values force the output to Standard_Output.
--
-- W_Char, W_Eol and W_Str can be used to change the default output
-- procedures. The default values force the output to Standard_Output.
-- Id is used to compute the display name of the project including its
-- proper casing.
--
-- Id is used to compute the display name of the project including its
-- proper casing.
--
- -- Max_Line_Length is the maximum line length in the project file.
+ -- Max_Line_Length is the maximum line length in the project file
OSDN Git Service
