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

exp_ch3.adb, [...]: Minor code reorganization.

Browse Source 
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.

From-SVN: r164979
This commit is contained in:
Robert Dewar 2010-10-05 10:14:50 +00:00 committed by Arnaud Charlet
parent 96d2756f41
commit 3ce5ca7546
15 changed files with 86 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
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

8
gcc/ada/exp_ch3.adb
View File

@ -4892,8 +4892,8 @@ package body Exp_Ch3 is
-- 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,
@ -4928,7 +4928,7 @@ package body Exp_Ch3 is
Expression => New_Expr));
-- Dynamically reference the tag associated with the
-- interface
-- interface.
Tag_Comp :=
Make_Function_Call (Loc,
@ -4945,7 +4945,7 @@ package body Exp_Ch3 is
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);

4
gcc/ada/exp_ch5.adb
View File

@ -1358,7 +1358,7 @@ package body Exp_Ch5 is
else
Expr :=
Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Rhs),
Prefix => Duplicate_Subexpr (Rhs),
Selector_Name => New_Occurrence_Of (C, Loc));
end if;
@ -1366,7 +1366,7 @@ package body Exp_Ch5 is
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);

8
gcc/ada/exp_disp.adb
View File

@ -481,11 +481,11 @@ package body Exp_Disp is
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
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);
@ -8023,7 +8023,7 @@ package body Exp_Disp is
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))))

1
gcc/ada/exp_dist.adb
View File

@ -11044,7 +11044,6 @@ package body Exp_Dist is
begin
if Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) then
null;
else
Serial := Increment_Serial_Number;
end if;

1
gcc/ada/gnatlink.adb
View File

@ -2001,6 +2001,7 @@ begin
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"

2
gcc/ada/makeutl.adb
View File

@ -38,7 +38,7 @@ with Tempdir;
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;

11
gcc/ada/par-ch6.adb
View File

@ -224,8 +224,10 @@ package body Ch6 is
-- 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!");
@ -374,11 +376,12 @@ package body Ch6 is
end if;
else
-- 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);
-- For function, scan result subtype
if Func then
TF_Return;

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

@ -179,7 +179,8 @@ package body Prj.Dect is
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
@ -214,7 +215,7 @@ package body Prj.Dect is
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
@ -239,8 +240,9 @@ package body Prj.Dect is
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);
begin
case Qualif is
when Aggregate =>
@ -308,6 +310,7 @@ package body Prj.Dect is
procedure Process_Attribute_Name is
Ignore : Boolean;
begin
Attribute_Name := Token_Name;
Set_Name_Of (Attribute, In_Tree, To => Attribute_Name);

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

@ -24,16 +24,17 @@
------------------------------------------------------------------------------
with Fmap;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Hostparm;
with Makeutl; use Makeutl;
with Makeutl; use Makeutl;
with Opt;
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 GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body Prj.Env is
Buffer_Initial : constant := 1_000;
@ -110,9 +111,10 @@ package body Prj.Env is
-- 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 --
@ -1780,7 +1782,8 @@ package body Prj.Env is
-----------------------------
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;
@ -1801,6 +1804,7 @@ package body Prj.Env is
begin
-- If already initialized, nothing else to do
if Self.Path /= null
and then Self.Path (Self.Path'First) /= '#'
then

26
gcc/ada/prj-env.ads
View File

@ -145,9 +145,9 @@ package Prj.Env is
(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);
@ -170,11 +170,10 @@ package Prj.Env is
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
@ -199,13 +198,14 @@ package Prj.Env is
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.
-- 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

4
gcc/ada/prj-ext.adb
View File

@ -23,8 +23,8 @@
-- --
------------------------------------------------------------------------------
with Osint; use Osint;
with Prj.Tree; use Prj.Tree;
with Osint; use Osint;
with Prj.Tree; use Prj.Tree;
package body Prj.Ext is

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

@ -23,11 +23,6 @@
-- --
------------------------------------------------------------------------------
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;
@ -45,6 +40,11 @@ with Ada.Strings; use Ada.Strings;
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 := "";
@ -4909,7 +4909,7 @@ package body Prj.Nmsc is
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;

34
gcc/ada/prj-part.adb
View File

@ -509,8 +509,10 @@ package body Prj.Part is
exception
when Types.Unrecoverable_Error =>
-- Unrecoverable_Error is raised when a line is too long.
-- A meaningful error message will be displayed later.
Project := Empty_Node;
end;
@ -535,7 +537,7 @@ package body Prj.Part is
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,
@ -544,9 +546,9 @@ package body Prj.Part is
-- 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;
@ -930,11 +932,12 @@ package body Prj.Part 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);
while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree);
@ -1174,7 +1177,7 @@ package body Prj.Part is
end;
if Has_Circular_Dependencies
(Flags, Normed_Path_Name, Canonical_Path_Name)
(Flags, Normed_Path_Name, Canonical_Path_Name)
then
Project := Empty_Node;
return;
@ -1641,18 +1644,17 @@ package body Prj.Part is
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
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
@ -1670,9 +1672,7 @@ package body Prj.Part is
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;

4
gcc/ada/prj-pp.ads
View File

@ -61,7 +61,7 @@ package Prj.PP is
-- 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.
@ -82,7 +82,7 @@ package Prj.PP is
-- 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
private