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

[multiple changes]

Browse Source 
2011-08-29  Gary Dismukes  <dismukes@adacore.com>

	* sem_type.adb: Minor reformatting.

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* makeutl.adb: Minor reformatting.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Object_Renaming): If the renamed object is a
	function call of a limited type, the expansion of the renaming is
	complicated by the presence of various temporaries and subtypes that
	capture constraints of the renamed object.
	Rewrite node as an object declaration, whose expansion is simpler.
	Given that the object is limited there is no copy involved and no
	performance hit.

From-SVN: r178187
This commit is contained in:
Arnaud Charlet 2011-08-29 12:19:00 +02:00
parent 164e06c6c1
commit 1378bf105e
4 changed files with 73 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -1,3 +1,21 @@
2011-08-29 Gary Dismukes <dismukes@adacore.com>
* sem_type.adb: Minor reformatting.
2011-08-29 Robert Dewar <dewar@adacore.com>
* makeutl.adb: Minor reformatting.
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Object_Renaming): If the renamed object is a
function call of a limited type, the expansion of the renaming is
complicated by the presence of various temporaries and subtypes that
capture constraints of the renamed object.
Rewrite node as an object declaration, whose expansion is simpler.
Given that the object is limited there is no copy involved and no
performance hit.
2011-08-29 Robert Dewar <dewar@adacore.com>
* exp_ch5.adb, sinfo.ads, make.adb, s-pooglo.adb, sem_ch12.adb,

14
gcc/ada/makeutl.adb
View File

@ -1560,13 +1560,17 @@ package body Makeutl is
if Is_Absolute_Path (Main) then
Main_Id := Create_Name (Base);
-- Not an absolute path
else
-- Always resolve links here, so that users can be
-- specify any name on the command line. If the
-- project itself uses links, the user will be
-- using -eL anyway, and thus files are also stored
-- with resolved names.
declare
-- Always resolve links here, so that users
-- can be specify any name on the command line.
-- If the project itself uses links, the user
-- will be using -eL anyway, and thus files are
-- also stored with resolved names.
Absolute : constant String :=
Normalize_Pathname
(Name => Main,

33
gcc/ada/sem_ch8.adb
View File

@ -682,6 +682,7 @@ package body Sem_Ch8 is
-----------------------------
procedure Analyze_Object_Renaming (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Id : constant Entity_Id := Defining_Identifier (N);
Dec : Node_Id;
Nam : constant Node_Id := Name (N);
@ -704,7 +705,6 @@ package body Sem_Ch8 is
------------------------------
procedure Check_Constrained_Object is
Loc : constant Source_Ptr := Sloc (N);
Subt : Entity_Id;
begin
@ -805,6 +805,29 @@ package body Sem_Ch8 is
Resolve (Nam, T);
-- If the renamed object is a function call of a limited type,
-- the expansion of the renaming is complicated by the presence
-- of various temporaries and subtypes that capture constraints
-- of the renamed object. Rewrite node as an object declaration,
-- whose expansion is simpler. Given that the object is limited
-- there is no copy involved and no performance hit.
if Nkind (Nam) = N_Function_Call
and then Is_Immutably_Limited_Type (Etype (Nam))
and then not Is_Constrained (T)
and then Comes_From_Source (N)
then
Set_Etype (Id, T);
Set_Ekind (Id, E_Constant);
Rewrite (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Id,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (T, Loc),
Expression => Relocate_Node (Nam)));
return;
end if;
-- Check that a class-wide object is not being renamed as an object
-- of a specific type. The test for access types is needed to exclude
-- cases where the renamed object is a dynamically tagged access
@ -2330,9 +2353,7 @@ package body Sem_Ch8 is
-- of a generic, its entity is set to the first available homonym.
-- We must first disambiguate the name, then set the proper entity.
if Is_Actual
and then Is_Overloaded (Nam)
then
if Is_Actual and then Is_Overloaded (Nam) then
Set_Entity (Nam, Old_S);
end if;
end if;
@ -2403,9 +2424,7 @@ package body Sem_Ch8 is
end if;
if Old_S /= Any_Id then
if Is_Actual
and then From_Default (N)
then
if Is_Actual and then From_Default (N) then
-- This is an implicit reference to the default actual
Generate_Reference (Old_S, Nam, Typ => 'i', Force => True);

27
gcc/ada/sem_type.adb
View File

@ -569,31 +569,34 @@ package body Sem_Type is
Ent : constant Entity_Id := Entity (N);
H : Entity_Id;
First_Interp : Interp_Index;
function Within_Instance (E : Entity_Id) return Boolean;
-- Within an instance there can be spurious ambiguities between a local
-- entity and one declared outside of the instance. This can only
-- happen for subprograms, because otherwise the local entity hides the
-- outer one. For overloadable entities, this predicate determines
-- whether it is a candidate within the instance, or must be ignored.
-- entity and one declared outside of the instance. This can only happen
-- for subprograms, because otherwise the local entity hides the outer
-- one. For an overloadable entity, this predicate determines whether it
-- is a candidate within the instance, or must be ignored.
---------------------
-- Within_Instance --
---------------------
function Within_Instance (E : Entity_Id) return Boolean is
Inst : Entity_Id;
Scop : Entity_Id;
begin
if not In_Instance then
return False;
end if;
Inst := Current_Scope;
while Present (Inst)
and then not Is_Generic_Instance (Inst)
loop
while Present (Inst) and then not Is_Generic_Instance (Inst) loop
Inst := Scope (Inst);
end loop;
Scop := Scope (E);
while Present (Scop)
and then Scop /= Standard_Standard
loop
Scop := Scope (E);
while Present (Scop) and then Scop /= Standard_Standard loop
if Scop = Inst then
return True;
end if;
@ -603,6 +606,8 @@ package body Sem_Type is
return False;
end Within_Instance;
-- Start of processing for Collect_Interps
begin
New_Interps (N);