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

exp_util.adb (Get_Current_Value_Condition, [...]): Handle the case of expressions with actions * exp_util.adb (Insert_Actions):... 

2013-10-17  Thomas Quinot  <quinot@adacore.com>

	* exp_util.adb (Get_Current_Value_Condition,
	Set_Current_Value_Condition): Handle the case of expressions
	with actions * exp_util.adb (Insert_Actions): Handle the case
	of an expression with actions whose Actions list is empty.
	* exp_util.adb (Remove_Side_Effects.Side_Effect_Free): An
	expression with actions that has no Actions and whose Expression
	is side effect free is itself side effect free.
	* exp_util.adb (Remove_Side_Effects): Do not set an incorrect etype on
	temporary 'R' (Def_Id), which is in general an access to Exp_Type, not
	an Exp_Type.
	* sem_res.adb (Resolve): For an expression with
	actions, resolve the expression early.	* sem_res.adb
	(Resolve_Expression_With_Actions): Rewrite an expression with
	actions whose value is compile time known and which has no
	actions into just its expression, so that its constant value is
	available downstream.
	* sem_res.adb (Resolve_Short_Circuit):
	Wrap the left operand in an expression with actions to contain
	any required finalization actions.
	* exp_ch4.adb (Expand_Expression_With_Actions): For an
	expression with actions returning a Boolean expression, ensure
	any finalization action is kept within the Actions list.
	* sem_warn.adb (Check_References, Check_Unset_Reference): add
	missing circuitry to handle expressions with actions.
	* checks.adb (Ensure_Valid): For an expression with actions,
	insert the validity check on the Expression.
	* sem_ch13.adb (Build_Static_Predicate.Get_RList): An expression
	with actions that has a non-empty Actions list is not static. An
	expression with actions that has an empty Actions list has the
	static ranges of its Expression.
	* sem_util.adb (Has_No_Obvious_Side_Effects): An expression with
	actions with an empty Actions list has no obvious side effects
	if its Expression itsekf has no obvious side effects.

From-SVN: r203763
This commit is contained in:
Thomas Quinot 2013-10-17 13:58:39 +00:00 committed by Arnaud Charlet
parent 51245e2db0
commit 064f4527c4
8 changed files with 270 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
gcc/ada/ChangeLog
View File

@ -1,3 +1,39 @@
2013-10-17 Thomas Quinot <quinot@adacore.com>
* exp_util.adb (Get_Current_Value_Condition,
Set_Current_Value_Condition): Handle the case of expressions
with actions * exp_util.adb (Insert_Actions): Handle the case
of an expression with actions whose Actions list is empty.
* exp_util.adb (Remove_Side_Effects.Side_Effect_Free): An
expression with actions that has no Actions and whose Expression
is side effect free is itself side effect free.
* exp_util.adb (Remove_Side_Effects): Do not set an incorrect etype on
temporary 'R' (Def_Id), which is in general an access to Exp_Type, not
an Exp_Type.
* sem_res.adb (Resolve): For an expression with
actions, resolve the expression early. * sem_res.adb
(Resolve_Expression_With_Actions): Rewrite an expression with
actions whose value is compile time known and which has no
actions into just its expression, so that its constant value is
available downstream.
* sem_res.adb (Resolve_Short_Circuit):
Wrap the left operand in an expression with actions to contain
any required finalization actions.
* exp_ch4.adb (Expand_Expression_With_Actions): For an
expression with actions returning a Boolean expression, ensure
any finalization action is kept within the Actions list.
* sem_warn.adb (Check_References, Check_Unset_Reference): add
missing circuitry to handle expressions with actions.
* checks.adb (Ensure_Valid): For an expression with actions,
insert the validity check on the Expression.
* sem_ch13.adb (Build_Static_Predicate.Get_RList): An expression
with actions that has a non-empty Actions list is not static. An
expression with actions that has an empty Actions list has the
static ranges of its Expression.
* sem_util.adb (Has_No_Obvious_Side_Effects): An expression with
actions with an empty Actions list has no obvious side effects
if its Expression itsekf has no obvious side effects.
2013-10-17 Ed Schonberg <schonberg@adacore.com>
* sem_aux.ads, sem_aux.adb (Is_Immutably_Limited_Type): Make

7
gcc/ada/checks.adb
View File

@ -5092,6 +5092,13 @@ package body Checks is
then
return;
-- For an expression with actions, we want to insert the validity check
-- on the final Expression.
elsif Nkind (Expr) = N_Expression_With_Actions then
Ensure_Valid (Expression (Expr));
return;
-- An annoying special case. If this is an out parameter of a scalar
-- type, then the value is not going to be accessed, therefore it is
-- inappropriate to do any validity check at the call site.

159
gcc/ada/exp_ch4.adb
View File

@ -12135,15 +12135,26 @@ package body Exp_Ch4 is
(Decl : Node_Id;
Rel_Node : Node_Id)
is
function Find_Enclosing_Context (N : Node_Id) return Node_Id;
-- Find the logical context where N appears. The context is chosen such
-- that it is possible to insert before and after it.
Hook_Context : Node_Id;
-- Node on which to insert the hook pointer (as an action)
----------------------------
-- Find_Enclosing_Context --
----------------------------
Finalization_Context : Node_Id;
-- Node after which to insert finalization actions
function Find_Enclosing_Context (N : Node_Id) return Node_Id is
Finalize_Always : Boolean;
-- If False, call to finalizer includes a test of whether the
-- hook pointer is null.
procedure Find_Enclosing_Contexts (N : Node_Id);
-- Find the logical context where N appears, and initializae
-- Hook_Context and Finalization_Context accordingly. Also
-- sets Finalize_Always.
-----------------------------
-- Find_Enclosing_Contexts --
-----------------------------
procedure Find_Enclosing_Contexts (N : Node_Id) is
Par : Node_Id;
Top : Node_Id;
@ -12153,7 +12164,7 @@ package body Exp_Ch4 is
-- other controlled values can reuse it.
if Scope_Is_Transient then
return Node_To_Be_Wrapped;
Hook_Context := Node_To_Be_Wrapped;
-- In some cases, such as return statements, no transient scope is
-- generated, in which case we have to look up in the tree to find
@ -12193,7 +12204,8 @@ package body Exp_Ch4 is
N_Parameter_Association,
N_Pragma_Argument_Association)
then
return Par;
Hook_Context := Par;
goto Hook_Context_Found;
-- Prevent the search from going too far
@ -12204,26 +12216,10 @@ package body Exp_Ch4 is
Par := Parent (Par);
end loop;
return Par;
-- Short circuit operators in complex expressions are converted into
-- expression_with_actions.
Hook_Context := Par;
goto Hook_Context_Found;
else
-- Handle the case where the node is buried deep inside an if
-- statement. The temporary controlled object must be finalized
-- before the then, elsif or else statements are evaluated.
-- if Something
-- and then Ctrl_Func_Call
-- then
-- <result must be finalized at this point>
-- <statements>
-- end if;
-- To achieve this, find the topmost logical operator. Generated
-- actions are then inserted before/after it.
Par := N;
while Present (Par) loop
@ -12267,7 +12263,8 @@ package body Exp_Ch4 is
N_Procedure_Call_Statement,
N_Simple_Return_Statement)
then
return Par;
Hook_Context := Par;
goto Hook_Context_Found;
-- Prevent the search from going too far
@ -12280,25 +12277,66 @@ package body Exp_Ch4 is
-- Return the topmost short circuit operator
return Top;
Hook_Context := Top;
end if;
end Find_Enclosing_Context;
<<Hook_Context_Found>>
-- Special case for Boolean EWAs: capture expression in a temporary,
-- whose declaration will serve as the context around which to insert
-- finalization code. The finalization thus remains local to the
-- specific condition being evaluated.
if Is_Boolean_Type (Etype (N)) then
-- In this case, the finalization context is chosen so that
-- we know at finalization point that the hook pointer is
-- never null, so no need for a test, we can call the finalizer
-- unconditionally.
Finalize_Always := True;
declare
Loc : constant Source_Ptr := Sloc (N);
Temp : constant Entity_Id := Make_Temporary (Loc, 'E', N);
begin
Append_To (Actions (N),
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (Etype (N), Loc),
Expression => Expression (N)));
Finalization_Context := Last (Actions (N));
Analyze (Last (Actions (N)));
Set_Expression (N, New_Occurrence_Of (Temp, Loc));
Analyze (Expression (N));
end;
else
Finalize_Always := False;
Finalization_Context := Hook_Context;
end if;
end Find_Enclosing_Contexts;
-- Local variables
Context : constant Node_Id := Find_Enclosing_Context (Rel_Node);
Loc : constant Source_Ptr := Sloc (Decl);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Node_Id := Etype (Obj_Id);
Desig_Typ : Entity_Id;
Expr : Node_Id;
Fin_Call : Node_Id;
Fin_Stmts : List_Id;
Ptr_Id : Entity_Id;
Temp_Id : Entity_Id;
-- Start of processing for Process_Transient_Object
begin
Find_Enclosing_Contexts (Rel_Node);
-- Step 1: Create the access type which provides a reference to the
-- transient controlled object.
@ -12315,7 +12353,7 @@ package body Exp_Ch4 is
Ptr_Id := Make_Temporary (Loc, 'A');
Insert_Action (Context,
Insert_Action (Hook_Context,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Ptr_Id,
Type_Definition =>
@ -12330,7 +12368,7 @@ package body Exp_Ch4 is
Temp_Id := Make_Temporary (Loc, 'T');
Insert_Action (Context,
Insert_Action (Hook_Context,
Make_Object_Declaration (Loc,
Defining_Identifier => Temp_Id,
Object_Definition => New_Reference_To (Ptr_Id, Loc)));
@ -12363,10 +12401,18 @@ package body Exp_Ch4 is
-- <or>
-- Temp := Obj_Id'Unrestricted_Access;
Insert_After_And_Analyze (Decl,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression => Expr));
if Finalization_Context /= Hook_Context then
Insert_Action (Finalization_Context,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression => Expr));
else
Insert_After_And_Analyze (Decl,
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression => Expr));
end if;
-- Step 4: Finalize the transient controlled object after the context
-- has been evaluated/elaborated. Generate:
@ -12383,26 +12429,29 @@ package body Exp_Ch4 is
-- insert the finalization code after the return statement as this will
-- render it unreachable.
if Nkind (Context) /= N_Simple_Return_Statement then
Fin_Call :=
Make_Implicit_If_Statement (Decl,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd => New_Reference_To (Temp_Id, Loc),
Right_Opnd => Make_Null (Loc)),
if Nkind (Finalization_Context) /= N_Simple_Return_Statement then
Fin_Stmts := New_List (
Make_Final_Call
(Obj_Ref =>
Make_Explicit_Dereference (Loc,
Prefix => New_Reference_To (Temp_Id, Loc)),
Typ => Desig_Typ),
Then_Statements => New_List (
Make_Final_Call
(Obj_Ref =>
Make_Explicit_Dereference (Loc,
Prefix => New_Reference_To (Temp_Id, Loc)),
Typ => Desig_Typ),
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression => Make_Null (Loc)));
Make_Assignment_Statement (Loc,
Name => New_Reference_To (Temp_Id, Loc),
Expression => Make_Null (Loc))));
if not Finalize_Always then
Fin_Stmts := New_List (
Make_Implicit_If_Statement (Decl,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd => New_Reference_To (Temp_Id, Loc),
Right_Opnd => Make_Null (Loc)),
Then_Statements => Fin_Stmts));
end if;
Insert_Action_After (Context, Fin_Call);
Insert_Actions_After (Finalization_Context, Fin_Stmts);
end if;
end Process_Transient_Object;

68
gcc/ada/exp_util.adb
View File

@ -2706,18 +2706,36 @@ package body Exp_Util is
(N : Node_Id;
S : Boolean)
is
Cond : Node_Id;
Sens : Boolean;
Cond : Node_Id;
Prev_Cond : Node_Id;
Sens : Boolean;
begin
Cond := N;
Sens := S;
-- Deal with NOT operators, inverting sense
loop
Prev_Cond := Cond;
while Nkind (Cond) = N_Op_Not loop
Cond := Right_Opnd (Cond);
Sens := not Sens;
-- Deal with NOT operators, inverting sense
while Nkind (Cond) = N_Op_Not loop
Cond := Right_Opnd (Cond);
Sens := not Sens;
end loop;
-- Deal with conversions, qualifications, and expressions with
-- actions.
while Nkind_In (Cond,
N_Type_Conversion,
N_Qualified_Expression,
N_Expression_With_Actions)
loop
Cond := Expression (Cond);
end loop;
exit when Cond = Prev_Cond;
end loop;
-- Deal with AND THEN and AND cases
@ -2798,8 +2816,15 @@ package body Exp_Util is
return;
-- Case of Boolean variable reference, return as though the
-- reference had said var = True.
elsif Nkind_In (Cond,
N_Type_Conversion,
N_Qualified_Expression,
N_Expression_With_Actions)
then
Cond := Expression (Cond);
-- Case of Boolean variable reference, return as though the
-- reference had said var = True.
else
if Is_Entity_Name (Cond) and then Ent = Entity (Cond) then
@ -3406,8 +3431,13 @@ package body Exp_Util is
when N_Expression_With_Actions =>
if N = Expression (P) then
Insert_List_After_And_Analyze
(Last (Actions (P)), Ins_Actions);
if Is_Empty_List (Actions (P)) then
Append_List_To (Actions (P), Ins_Actions);
Analyze_List (Actions (P));
else
Insert_List_After_And_Analyze
(Last (Actions (P)), Ins_Actions);
end if;
return;
end if;
@ -6702,6 +6732,14 @@ package body Exp_Util is
when N_Explicit_Dereference =>
return Safe_Prefixed_Reference (N);
-- An expression with action is side effect free if its expression
-- is side effect free and it has no actions.
when N_Expression_With_Actions =>
return Is_Empty_List (Actions (N))
and then
Side_Effect_Free (Expression (N));
-- A call to _rep_to_pos is side effect free, since we generate
-- this pure function call ourselves. Moreover it is critically
-- important to make this exception, since otherwise we can have
@ -7103,7 +7141,6 @@ package body Exp_Util is
end if;
Def_Id := Make_Temporary (Loc, 'R', Exp);
Set_Etype (Def_Id, Exp_Type);
-- The regular expansion of functions with side effects involves the
-- generation of an access type to capture the return value found on
@ -7780,7 +7817,14 @@ package body Exp_Util is
Set_Entity_Current_Value (Right_Opnd (Cond));
end if;
-- Check possible boolean variable reference
elsif Nkind_In (Cond,
N_Type_Conversion,
N_Qualified_Expression,
N_Expression_With_Actions)
then
Set_Expression_Current_Value (Expression (Cond));
-- Check possible boolean variable reference
else
Set_Entity_Current_Value (Cond);

10
gcc/ada/sem_ch13.adb
View File

@ -7279,6 +7279,16 @@ package body Sem_Ch13 is
when N_Qualified_Expression =>
return Get_RList (Expression (Exp));
-- Expression with actions: if no actions, dig out expression
when N_Expression_With_Actions =>
if Is_Empty_List (Actions (Exp)) then
return Get_RList (Expression (Exp));
else
raise Non_Static;
end if;
-- Xor operator
when N_Op_Xor =>

46
gcc/ada/sem_res.adb
View File

@ -2095,10 +2095,19 @@ package body Sem_Res is
Check_Parameterless_Call (N);
-- The resolution of an Expression_With_Actions is determined by
-- its Expression.
if Nkind (N) = N_Expression_With_Actions then
Resolve (Expression (N), Typ);
Found := True;
Expr_Type := Etype (Expression (N));
-- If not overloaded, then we know the type, and all that needs doing
-- is to check that this type is compatible with the context.
if not Is_Overloaded (N) then
elsif not Is_Overloaded (N) then
Found := Covers (Typ, Etype (N));
Expr_Type := Etype (N);
@ -7274,6 +7283,17 @@ package body Sem_Res is
procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id) is
begin
Set_Etype (N, Typ);
-- If N has no actions, and its expression has been constant folded,
-- then rewrite N as just its expression. Note, we can't do this in
-- the general case of Is_Empty_List (Actions (N)) as this would cause
-- Expression (N) to be expanded again.
if Is_Empty_List (Actions (N))
and then Compile_Time_Known_Value (Expression (N))
then
Rewrite (N, Expression (N));
end if;
end Resolve_Expression_With_Actions;
---------------------------
@ -8996,6 +9016,30 @@ package body Sem_Res is
R : constant Node_Id := Right_Opnd (N);
begin
-- Ensure all actions associated with the left operand (e.g.
-- finalization of transient controlled objects) are fully evaluated
-- locally within an expression with actions. This is particularly
-- helpful for coverage analysis. However this should not happen in
-- generics.
if Expander_Active then
declare
Reloc_L : constant Node_Id := Relocate_Node (L);
begin
Save_Interps (Old_N => L, New_N => Reloc_L);
Rewrite (L,
Make_Expression_With_Actions (Sloc (L),
Actions => New_List,
Expression => Reloc_L));
-- Set Comes_From_Source on L to preserve warnings for unset
-- reference.
Set_Comes_From_Source (L, Comes_From_Source (Reloc_L));
end;
end if;
Resolve (L, B_Typ);
Resolve (R, B_Typ);

6
gcc/ada/sem_util.adb
View File

@ -6777,6 +6777,12 @@ package body Sem_Util is
and then
Has_No_Obvious_Side_Effects (Right_Opnd (N));
elsif Nkind (N) = N_Expression_With_Actions
and then
Is_Empty_List (Actions (N))
then
return Has_No_Obvious_Side_Effects (Expression (N));
elsif Nkind (N) in N_Has_Entity then
return Present (Entity (N))
and then Ekind_In (Entity (N), E_Variable,

8
gcc/ada/sem_warn.adb
View File

@ -1310,6 +1310,7 @@ package body Sem_Warn is
UR := Original_Node (UR);
while Nkind (UR) = N_Type_Conversion
or else Nkind (UR) = N_Qualified_Expression
or else Nkind (UR) = N_Expression_With_Actions
loop
UR := Expression (UR);
end loop;
@ -2034,9 +2035,12 @@ package body Sem_Warn is
Check_Unset_Reference (Pref);
end;
-- For type conversions or qualifications examine the expression
-- For type conversions, qualifications, or expressions with actions,
-- examine the expression.
when N_Type_Conversion | N_Qualified_Expression =>
when N_Type_Conversion |
N_Qualified_Expression |
N_Expression_With_Actions =>
Check_Unset_Reference (Expression (N));
-- For explicit dereference, always check prefix, which will generate