Commit 17d65c91 by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Unnesting: don't use Get_Actual_Subtype for record subtypes

2018-07-17  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Unnest_Subprograms): Do nothing if the expander is not
	active.  Don't use Get_Actual_Subtype for record subtypes.  Ignore
	rewritten identifiers and uplevel references to bounds of types that
	come from the original type reference.

From-SVN: r262787
parent f2c2cdfb
2018-07-17 Ed Schonberg <schonberg@adacore.com>
* exp_unst.adb (Unnest_Subprograms): Do nothing if the expander is not
active. Don't use Get_Actual_Subtype for record subtypes. Ignore
rewritten identifiers and uplevel references to bounds of types that
come from the original type reference.
2018-07-17 Hristian Kirtchev <kirtchev@adacore.com> 2018-07-17 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch13.adb, exp_ch7.adb, exp_unst.adb, freeze.adb, * exp_ch13.adb, exp_ch7.adb, exp_unst.adb, freeze.adb,
......
...@@ -721,6 +721,10 @@ package body Exp_Unst is ...@@ -721,6 +721,10 @@ package body Exp_Unst is
Bod => Bod, Bod => Bod,
Lev => L, Lev => L,
Reachable => In_Synchronized_Unit (E), Reachable => In_Synchronized_Unit (E),
-- Subprograms declared in tasks and protected types are
-- reachable and cannot be eliminated.
Uplevel_Ref => L, Uplevel_Ref => L,
Declares_AREC => False, Declares_AREC => False,
Uents => No_Elist, Uents => No_Elist,
...@@ -1932,7 +1936,7 @@ package body Exp_Unst is ...@@ -1932,7 +1936,7 @@ package body Exp_Unst is
-- If we have a loop parameter, we have -- If we have a loop parameter, we have
-- to insert before the first statement -- to insert before the first statement
-- of the loop. Ins points to the -- of the loop. Ins points to the
-- N_Loop_Parametrer_Specification. -- N_Loop_Parameter_Specification.
if Ekind (Ent) = E_Loop_Parameter then if Ekind (Ent) = E_Loop_Parameter then
Ins := Ins :=
...@@ -1980,9 +1984,18 @@ package body Exp_Unst is ...@@ -1980,9 +1984,18 @@ package body Exp_Unst is
begin begin
-- Ignore type references, these are implicit references that do -- Ignore type references, these are implicit references that do
-- not need rewriting (e.g. the appearence in a conversion). -- not need rewriting (e.g. the appearence in a conversion).
-- Also ignore if no reference was specified. -- Also ignore if no reference was specified or if the rewriting
-- has already been done (this can happen if the N_Identifier
-- occurs more than one time in the tree).
-- Also ignore uplevel references to bounds of types that come
-- from the original type reference.
if Is_Type (UPJ.Ent) or else No (UPJ.Ref) then if Is_Type (UPJ.Ent)
or else No (UPJ.Ref)
or else not Is_Entity_Name (UPJ.Ref)
or else not Present (Entity (UPJ.Ref))
or else Is_Type (Entity (UPJ.Ref))
then
goto Continue; goto Continue;
end if; end if;
...@@ -2005,7 +2018,7 @@ package body Exp_Unst is ...@@ -2005,7 +2018,7 @@ package body Exp_Unst is
Typ : constant Entity_Id := Etype (UPJ.Ent); Typ : constant Entity_Id := Etype (UPJ.Ent);
-- The type of the referenced entity -- The type of the referenced entity
Atyp : constant Entity_Id := Get_Actual_Subtype (UPJ.Ref); Atyp : Entity_Id;
-- The actual subtype of the reference -- The actual subtype of the reference
RS_Caller : constant SI_Type := Subp_Index (UPJ.Caller); RS_Caller : constant SI_Type := Subp_Index (UPJ.Caller);
...@@ -2025,6 +2038,12 @@ package body Exp_Unst is ...@@ -2025,6 +2038,12 @@ package body Exp_Unst is
SI : SI_Type; SI : SI_Type;
begin begin
Atyp := Etype (UPJ.Ref);
if Ekind (Atyp) /= E_Record_Subtype then
Atyp := Get_Actual_Subtype (UPJ.Ref);
end if;
-- Ignore if no ARECnF entity for enclosing subprogram which -- Ignore if no ARECnF entity for enclosing subprogram which
-- probably happens as a result of not properly treating -- probably happens as a result of not properly treating
-- instance bodies. To be examined ??? -- instance bodies. To be examined ???
...@@ -2344,7 +2363,7 @@ package body Exp_Unst is ...@@ -2344,7 +2363,7 @@ package body Exp_Unst is
-- Start of processing for Unnest_Subprograms -- Start of processing for Unnest_Subprograms
begin begin
if not Opt.Unnest_Subprogram_Mode then if not Opt.Unnest_Subprogram_Mode or not Opt.Expander_Active then
return; return;
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment