Commit 0d756922 by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Unnesting: improve support for entries in protected objects

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

gcc/ada/

	* exp_unst.adb (Subp_Index): In the case of a protected
	operation, the relevant entry is the generated
	protected_subprogram_body into which the original body is
	rewritten. Assorted cleanup and optimizations.

From-SVN: r263105
parent 948071fa
2018-07-31 Ed Schonberg <schonberg@adacore.com> 2018-07-31 Ed Schonberg <schonberg@adacore.com>
* exp_unst.adb (Subp_Index): In the case of a protected
operation, the relevant entry is the generated
protected_subprogram_body into which the original body is
rewritten. Assorted cleanup and optimizations.
2018-07-31 Ed Schonberg <schonberg@adacore.com>
* exp_attr.adb (Expand_Attribute, case Fixed_Value): Set the * exp_attr.adb (Expand_Attribute, case Fixed_Value): Set the
base type of the result to ensure that proper overflow and range base type of the result to ensure that proper overflow and range
checks are generated. If the target is a fixed-point tyoe, checks are generated. If the target is a fixed-point tyoe,
......
...@@ -259,6 +259,16 @@ package body Exp_Unst is ...@@ -259,6 +259,16 @@ package body Exp_Unst is
if Subps_Index (E) = Uint_0 then if Subps_Index (E) = Uint_0 then
E := Ultimate_Alias (E); E := Ultimate_Alias (E);
-- The body of a protected operation has a different name and
-- has been scanned at this point, and thus has an entry in
-- the subprogram table.
if E = Sub
and then Convention (E) = Convention_Protected
then
E := Protected_Body_Subprogram (E);
end if;
if Ekind (E) = E_Function if Ekind (E) = E_Function
and then Rewritten_For_C (E) and then Rewritten_For_C (E)
and then Present (Corresponding_Procedure (E)) and then Present (Corresponding_Procedure (E))
...@@ -494,12 +504,13 @@ package body Exp_Unst is ...@@ -494,12 +504,13 @@ package body Exp_Unst is
if Is_Entity_Name (N) then if Is_Entity_Name (N) then
if Present (Entity (N)) if Present (Entity (N))
and then not Is_Type (Entity (N))
and then Present (Enclosing_Subprogram (Entity (N))) and then Present (Enclosing_Subprogram (Entity (N)))
and then Ekind (Entity (N)) /= E_Discriminant and then Ekind (Entity (N)) /= E_Discriminant
then then
Note_Uplevel_Ref Note_Uplevel_Ref
(E => Entity (N), (E => Entity (N),
N => Ref, N => Empty,
Caller => Current_Subprogram, Caller => Current_Subprogram,
Callee => Enclosing_Subprogram (Entity (N))); Callee => Enclosing_Subprogram (Entity (N)));
end if; end if;
...@@ -538,9 +549,12 @@ package body Exp_Unst is ...@@ -538,9 +549,12 @@ package body Exp_Unst is
elsif Nkind (N) in N_Unary_Op then elsif Nkind (N) in N_Unary_Op then
Note_Uplevel_Bound (Right_Opnd (N), Ref); Note_Uplevel_Bound (Right_Opnd (N), Ref);
-- Explicit dereference case -- Explicit dereference and selected component case
elsif Nkind (N) = N_Explicit_Dereference then elsif Nkind_In (N,
N_Explicit_Dereference,
N_Selected_Component)
then
Note_Uplevel_Bound (Prefix (N), Ref); Note_Uplevel_Bound (Prefix (N), Ref);
-- Conversion case -- Conversion case
...@@ -861,6 +875,20 @@ package body Exp_Unst is ...@@ -861,6 +875,20 @@ package body Exp_Unst is
Check_Static_Type Check_Static_Type
(Etype (Expression (Expression (N))), Empty, DT); (Etype (Expression (Expression (N))), Empty, DT);
end; end;
-- For a Return or Free (all other nodes we handle here),
-- we usually need the size of the object, so we need to be
-- sure that any nonstatic bounds of the expression's type
-- that are uplevel are handled.
elsif Nkind (N) /= N_Allocator
and then Present (Expression (N))
then
declare
DT : Boolean := False;
begin
Check_Static_Type (Etype (Expression (N)), Empty, DT);
end;
end if; end if;
-- A 'Access reference is a (potential) call. So is 'Address, -- A 'Access reference is a (potential) call. So is 'Address,
...@@ -1141,10 +1169,7 @@ package body Exp_Unst is ...@@ -1141,10 +1169,7 @@ package body Exp_Unst is
begin begin
Check_Static_Type (Ent, N, DT); Check_Static_Type (Ent, N, DT);
return OK;
if Is_Static_Type (Ent) then
return OK;
end if;
end; end;
end if; end if;
...@@ -1336,10 +1361,7 @@ package body Exp_Unst is ...@@ -1336,10 +1361,7 @@ package body Exp_Unst is
and then Ekind (URJ.Ent) /= E_Discriminant and then Ekind (URJ.Ent) /= E_Discriminant
then then
Set_Is_Uplevel_Referenced_Entity (URJ.Ent); Set_Is_Uplevel_Referenced_Entity (URJ.Ent);
Append_New_Elmt (URJ.Ent, SUBT.Uents);
if not Is_Type (URJ.Ent) then
Append_New_Elmt (URJ.Ent, SUBT.Uents);
end if;
end if; end if;
-- And set uplevel indication for caller -- And set uplevel indication for caller
...@@ -1395,7 +1417,8 @@ package body Exp_Unst is ...@@ -1395,7 +1417,8 @@ package body Exp_Unst is
Write_Eol; Write_Eol;
end if; end if;
-- Rewrite declaration and body to null statements -- Rewrite declaration, body, and corresponding freeze node
-- to null statements.
-- A subprogram instantiation does not have an explicit -- A subprogram instantiation does not have an explicit
-- body. If unused, we could remove the corresponding -- body. If unused, we could remove the corresponding
...@@ -1407,6 +1430,11 @@ package body Exp_Unst is ...@@ -1407,6 +1430,11 @@ package body Exp_Unst is
if Present (Spec) then if Present (Spec) then
Decl := Parent (Declaration_Node (Spec)); Decl := Parent (Declaration_Node (Spec));
Rewrite (Decl, Make_Null_Statement (Sloc (Decl))); Rewrite (Decl, Make_Null_Statement (Sloc (Decl)));
if Present (Freeze_Node (Spec)) then
Rewrite (Freeze_Node (Spec),
Make_Null_Statement (Sloc (Decl)));
end if;
end if; end if;
Rewrite (STJ.Bod, Make_Null_Statement (Sloc (STJ.Bod))); Rewrite (STJ.Bod, Make_Null_Statement (Sloc (STJ.Bod)));
...@@ -1829,7 +1857,11 @@ package body Exp_Unst is ...@@ -1829,7 +1857,11 @@ package body Exp_Unst is
Decl_Assign := Empty; Decl_Assign := Empty;
end if; end if;
Prepend_List_To (Declarations (STJ.Bod), Decls); if No (Declarations (STJ.Bod)) then
Set_Declarations (STJ.Bod, Decls);
else
Prepend_List_To (Declarations (STJ.Bod), Decls);
end if;
-- Analyze the newly inserted declarations. Note that we -- Analyze the newly inserted declarations. Note that we
-- do not need to establish the whole scope stack, since -- do not need to establish the whole scope stack, since
...@@ -1987,24 +2019,10 @@ package body Exp_Unst is ...@@ -1987,24 +2019,10 @@ package body Exp_Unst is
-- Also ignore if no reference was specified or if the rewriting -- Also ignore if no reference was specified or if the rewriting
-- has already been done (this can happen if the N_Identifier -- has already been done (this can happen if the N_Identifier
-- occurs more than one time in the tree). -- 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) if No (UPJ.Ref)
or else No (UPJ.Ref)
or else not Is_Entity_Name (UPJ.Ref) or else not Is_Entity_Name (UPJ.Ref)
or else not Present (Entity (UPJ.Ref)) or else not Present (Entity (UPJ.Ref))
or else Is_Type (Entity (UPJ.Ref))
then
goto Continue;
end if;
-- Also ignore uplevel references to bounds of types that come
-- from the original type reference.
if Is_Entity_Name (UPJ.Ref)
and then Present (Entity (UPJ.Ref))
and then Is_Type (Entity (UPJ.Ref))
then then
goto Continue; goto Continue;
end if; end if;
...@@ -2347,13 +2365,12 @@ package body Exp_Unst is ...@@ -2347,13 +2365,12 @@ package body Exp_Unst is
Unnest_Subprogram (Spec_Id, N); Unnest_Subprogram (Spec_Id, N);
end if; end if;
end; end;
end if;
-- The proper body of a stub may contain nested subprograms, and -- The proper body of a stub may contain nested subprograms, and
-- therefore must be visited explicitly. Nested stubs are examined -- therefore must be visited explicitly. Nested stubs are examined
-- recursively in Visit_Node. -- recursively in Visit_Node.
if Nkind (N) in N_Body_Stub then elsif Nkind (N) in N_Body_Stub then
Do_Search (Library_Unit (N)); Do_Search (Library_Unit (N));
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