[multiple changes]
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:
parent
164e06c6c1
commit
1378bf105e
@ -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>
|
2011-08-29 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
* exp_ch5.adb, sinfo.ads, make.adb, s-pooglo.adb, sem_ch12.adb,
|
* exp_ch5.adb, sinfo.ads, make.adb, s-pooglo.adb, sem_ch12.adb,
|
||||||
|
@ -1560,13 +1560,17 @@ package body Makeutl is
|
|||||||
|
|
||||||
if Is_Absolute_Path (Main) then
|
if Is_Absolute_Path (Main) then
|
||||||
Main_Id := Create_Name (Base);
|
Main_Id := Create_Name (Base);
|
||||||
|
|
||||||
|
-- Not an absolute path
|
||||||
|
|
||||||
else
|
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
|
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 :=
|
Absolute : constant String :=
|
||||||
Normalize_Pathname
|
Normalize_Pathname
|
||||||
(Name => Main,
|
(Name => Main,
|
||||||
|
@ -682,9 +682,10 @@ package body Sem_Ch8 is
|
|||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
||||||
procedure Analyze_Object_Renaming (N : Node_Id) is
|
procedure Analyze_Object_Renaming (N : Node_Id) is
|
||||||
Id : constant Entity_Id := Defining_Identifier (N);
|
Loc : constant Source_Ptr := Sloc (N);
|
||||||
|
Id : constant Entity_Id := Defining_Identifier (N);
|
||||||
Dec : Node_Id;
|
Dec : Node_Id;
|
||||||
Nam : constant Node_Id := Name (N);
|
Nam : constant Node_Id := Name (N);
|
||||||
T : Entity_Id;
|
T : Entity_Id;
|
||||||
T2 : Entity_Id;
|
T2 : Entity_Id;
|
||||||
|
|
||||||
@ -704,7 +705,6 @@ package body Sem_Ch8 is
|
|||||||
------------------------------
|
------------------------------
|
||||||
|
|
||||||
procedure Check_Constrained_Object is
|
procedure Check_Constrained_Object is
|
||||||
Loc : constant Source_Ptr := Sloc (N);
|
|
||||||
Subt : Entity_Id;
|
Subt : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -805,6 +805,29 @@ package body Sem_Ch8 is
|
|||||||
|
|
||||||
Resolve (Nam, T);
|
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
|
-- 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
|
-- of a specific type. The test for access types is needed to exclude
|
||||||
-- cases where the renamed object is a dynamically tagged access
|
-- 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.
|
-- of a generic, its entity is set to the first available homonym.
|
||||||
-- We must first disambiguate the name, then set the proper entity.
|
-- We must first disambiguate the name, then set the proper entity.
|
||||||
|
|
||||||
if Is_Actual
|
if Is_Actual and then Is_Overloaded (Nam) then
|
||||||
and then Is_Overloaded (Nam)
|
|
||||||
then
|
|
||||||
Set_Entity (Nam, Old_S);
|
Set_Entity (Nam, Old_S);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
@ -2403,9 +2424,7 @@ package body Sem_Ch8 is
|
|||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Old_S /= Any_Id then
|
if Old_S /= Any_Id then
|
||||||
if Is_Actual
|
if Is_Actual and then From_Default (N) then
|
||||||
and then From_Default (N)
|
|
||||||
then
|
|
||||||
-- This is an implicit reference to the default actual
|
-- This is an implicit reference to the default actual
|
||||||
|
|
||||||
Generate_Reference (Old_S, Nam, Typ => 'i', Force => True);
|
Generate_Reference (Old_S, Nam, Typ => 'i', Force => True);
|
||||||
|
@ -569,31 +569,34 @@ package body Sem_Type is
|
|||||||
Ent : constant Entity_Id := Entity (N);
|
Ent : constant Entity_Id := Entity (N);
|
||||||
H : Entity_Id;
|
H : Entity_Id;
|
||||||
First_Interp : Interp_Index;
|
First_Interp : Interp_Index;
|
||||||
|
|
||||||
function Within_Instance (E : Entity_Id) return Boolean;
|
function Within_Instance (E : Entity_Id) return Boolean;
|
||||||
-- Within an instance there can be spurious ambiguities between a local
|
-- Within an instance there can be spurious ambiguities between a local
|
||||||
-- entity and one declared outside of the instance. This can only
|
-- entity and one declared outside of the instance. This can only happen
|
||||||
-- happen for subprograms, because otherwise the local entity hides the
|
-- for subprograms, because otherwise the local entity hides the outer
|
||||||
-- outer one. For overloadable entities, this predicate determines
|
-- one. For an overloadable entity, this predicate determines whether it
|
||||||
-- whether it is a candidate within the instance, or must be ignored.
|
-- is a candidate within the instance, or must be ignored.
|
||||||
|
|
||||||
|
---------------------
|
||||||
|
-- Within_Instance --
|
||||||
|
---------------------
|
||||||
|
|
||||||
function Within_Instance (E : Entity_Id) return Boolean is
|
function Within_Instance (E : Entity_Id) return Boolean is
|
||||||
Inst : Entity_Id;
|
Inst : Entity_Id;
|
||||||
Scop : Entity_Id;
|
Scop : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if not In_Instance then
|
if not In_Instance then
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Inst := Current_Scope;
|
Inst := Current_Scope;
|
||||||
while Present (Inst)
|
while Present (Inst) and then not Is_Generic_Instance (Inst) loop
|
||||||
and then not Is_Generic_Instance (Inst)
|
|
||||||
loop
|
|
||||||
Inst := Scope (Inst);
|
Inst := Scope (Inst);
|
||||||
end loop;
|
end loop;
|
||||||
Scop := Scope (E);
|
|
||||||
|
|
||||||
while Present (Scop)
|
Scop := Scope (E);
|
||||||
and then Scop /= Standard_Standard
|
while Present (Scop) and then Scop /= Standard_Standard loop
|
||||||
loop
|
|
||||||
if Scop = Inst then
|
if Scop = Inst then
|
||||||
return True;
|
return True;
|
||||||
end if;
|
end if;
|
||||||
@ -603,6 +606,8 @@ package body Sem_Type is
|
|||||||
return False;
|
return False;
|
||||||
end Within_Instance;
|
end Within_Instance;
|
||||||
|
|
||||||
|
-- Start of processing for Collect_Interps
|
||||||
|
|
||||||
begin
|
begin
|
||||||
New_Interps (N);
|
New_Interps (N);
|
||||||
|
|
||||||
@ -660,8 +665,8 @@ package body Sem_Type is
|
|||||||
-- within the instance must not be included.
|
-- within the instance must not be included.
|
||||||
|
|
||||||
if Within_Instance (H)
|
if Within_Instance (H)
|
||||||
and then H /= Renamed_Entity (Ent)
|
and then H /= Renamed_Entity (Ent)
|
||||||
and then not Is_Inherited_Operation (H)
|
and then not Is_Inherited_Operation (H)
|
||||||
then
|
then
|
||||||
All_Interp.Table (All_Interp.Last) :=
|
All_Interp.Table (All_Interp.Last) :=
|
||||||
(H, Etype (H), Empty);
|
(H, Etype (H), Empty);
|
||||||
|
Loading…
Reference in New Issue
Block a user