From: Eric Botcazou <[email protected]>
The underlying problem is that declare expressions are implemented by means
of a temporary in most cases and that's incompatible with limited types.
gcc/ada/ChangeLog:
* exp_ch4.adb (Expand_N_Expression_With_Actions): Create a temporary
only for types that can be copied, and replace the EWA node by its
expression for other types.
* exp_ch6.adb (Expand_Ctrl_Function_Call): Bail out when the parent
is an EWA node.
* sem_ch3.adb (OK_For_Limited_Init_In_05): Recurse on the expression
of an EWA node.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch4.adb | 168 ++++++++++++++++++++++++++------------------
gcc/ada/exp_ch6.adb | 6 ++
gcc/ada/sem_ch3.adb | 10 +--
3 files changed, 110 insertions(+), 74 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7279fe3cf76..fde321a0ba5 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5600,57 +5600,76 @@ package body Exp_Ch4 is
--------------------------------------
procedure Expand_N_Expression_With_Actions (N : Node_Id) is
- Acts : constant List_Id := Actions (N);
+ Acts : constant List_Id := Actions (N);
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
- procedure Force_Boolean_Evaluation (Expr : Node_Id);
- -- Force the evaluation of Boolean expression Expr
+ function Is_Copy_Type (Typ : Entity_Id) return Boolean;
+ -- Return True if we can copy objects of this type when expanding the
+ -- node. The function must return False for limited types for semantic
+ -- reasons, and more generally should do so for all by-reference types.
+ -- Of course the run-time performance of the copy operation should also
+ -- be taken into account, but the expansion of conditional expressions
+ -- may choose to create EWA nodes instead of conditional statements to
+ -- deal with the actions, in which case these EWA nodes also need to be
+ -- preserved for semantic reasons. In practice, this means that the
+ -- subset of types accepted by this Is_Copy_Type predicate must contain
+ -- the union of the subsets of types accepted by its homonyms in the
+ -- Expand_N_Case_Expression and Expand_N_If_Expression procedures, in
+ -- other words must return True when at least one of them returns true.
+ -- This implementation is that of Expand_N_If_Expression.Is_Copy_Type,
+ -- which already accepts a superset of the types accepted by its twin
+ -- Expand_N_Case_Expression.Is_Copy_Type predicate.
- ------------------------------
- -- Force_Boolean_Evaluation --
- ------------------------------
+ ------------------
+ -- Is_Copy_Type --
+ ------------------
- procedure Force_Boolean_Evaluation (Expr : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Flag_Decl : Node_Id;
- Flag_Id : Entity_Id;
+ function Is_Copy_Type (Typ : Entity_Id) return Boolean is
+ Utyp : constant Entity_Id := Underlying_Type (Typ);
begin
- -- Relocate the expression to the actions list by capturing its value
- -- in a Boolean flag. Generate:
- -- Flag : constant Boolean := Expr;
+ return Is_Definite_Subtype (Utyp)
+ and then not Is_By_Reference_Type (Utyp);
+ end Is_Copy_Type;
- Flag_Id := Make_Temporary (Loc, 'F');
+ -- Local variables
- Flag_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Flag_Id,
- Constant_Present => True,
- Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc),
- Expression => Relocate_Node (Expr));
-
- Append (Flag_Decl, Acts);
- Analyze (Flag_Decl);
-
- -- Replace the expression with a reference to the flag
-
- Rewrite (Expression (N), New_Occurrence_Of (Flag_Id, Loc));
- Analyze (Expression (N));
- end Force_Boolean_Evaluation;
+ Temp_Decl : Node_Id;
+ Temp_Id : Entity_Id;
+ Temp_Ref : Node_Id;
-- Start of processing for Expand_N_Expression_With_Actions
begin
+ -- A check is first needed since the subtype of the EWA node and the
+ -- subtype of the expression may differ (for example, the EWA node
+ -- may have a null-excluding access subtype).
+
+ Apply_Constraint_Check (Expression (N), Typ);
+
+ -- Deal with case where there are no actions. In this case we simply
+ -- rewrite the node with its expression since we don't need the actions
+ -- and the specification of this node does not allow a null action list.
+
+ -- Note: we use Rewrite instead of Replace, because Codepeer is using
+ -- the expanded tree and relying on being able to retrieve the original
+ -- tree in cases like this. This raises a whole lot of issues of whether
+ -- we have problems elsewhere, which will be addressed in the future???
+
+ if Is_Empty_List (Acts) then
+ Rewrite (N, Relocate_Node (Expression (N)));
+ Analyze_And_Resolve (N, Typ);
+
-- Do not evaluate the expression when it denotes an entity because the
- -- expression_with_actions node will be replaced by the reference.
+ -- EWA node will simply be replaced by the reference. Likewise if it was
+ -- rewritten as a raise node. But nevertheless process transient objects
+ -- found within the actions of the EWA node.
- if Is_Entity_Name (Expression (N)) then
- null;
-
- -- Do not evaluate the expression when there are no actions because the
- -- expression_with_actions node will be replaced by the expression.
-
- elsif Is_Empty_List (Acts) then
- null;
+ elsif Is_Entity_Name (Expression (N))
+ or else Nkind (Expression (N)) in N_Raise_xxx_Error
+ then
+ Process_Transients_In_Expression (N, Acts);
-- Force the evaluation of the expression by capturing its value in a
-- temporary. This ensures that aliases of transient objects do not leak
@@ -5676,42 +5695,53 @@ package body Exp_Ch4 is
-- Once this transformation is performed, it is safe to finalize the
-- transient object at the end of the actions list.
- -- Note that Force_Evaluation does not remove side effects in operators
- -- because it assumes that all operands are evaluated and side effect
- -- free. This is not the case when an operand depends implicitly on the
- -- transient object through the use of access types.
+ elsif Is_Copy_Type (Typ) then
+ -- Relocate the expression to the actions list by capturing its value
+ -- in a temporary. Generate:
+ --
+ -- Temp : constant Exp_Typ := Exp;
- elsif Is_Boolean_Type (Etype (Expression (N))) then
- Force_Boolean_Evaluation (Expression (N));
+ Temp_Id := Make_Temporary (Loc, 'F');
- -- The expression of an expression_with_actions node may not necessarily
- -- be Boolean when the node appears in an if expression. In this case do
- -- the usual forced evaluation to encapsulate potential aliasing.
+ Temp_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp_Id,
+ Constant_Present => True,
+ Object_Definition =>
+ New_Occurrence_Of (Etype (Expression (N)), Loc),
+ Expression => Relocate_Node (Expression (N)));
+
+ Append (Temp_Decl, Acts);
+ Analyze (Temp_Decl);
+
+ Temp_Ref := New_Occurrence_Of (Temp_Id, Loc);
+
+ -- Copy the Do_Range_Check flag that may have been set above
+
+ Set_Do_Range_Check (Temp_Ref, Do_Range_Check (Expression (N)));
+
+ -- Replace the expression with a reference to the temporary
+
+ Rewrite (Expression (N), Temp_Ref);
+
+ -- Process transient objects found within the actions of the EWA node
+
+ Process_Transients_In_Expression (N, Acts);
+
+ -- Otherwise insert the actions and replace the EWA by its expression.
+ -- This is necessary for limited types, and desirable for by-reference
+ -- types, because we cannot or should not create a temporary for them.
+ -- This means that the management of transient objects is deferred to
+ -- the enclosing context where the actions are inserted.
else
- -- A check is also needed since the subtype of the EWA node and the
- -- subtype of the expression may differ (for example, the EWA node
- -- may have a null-excluding access subtype).
-
- Apply_Constraint_Check (Expression (N), Etype (N));
- Force_Evaluation (Expression (N));
- end if;
-
- -- Process transient objects found within the actions of the EWA node
-
- Process_Transients_In_Expression (N, Acts);
-
- -- Deal with case where there are no actions. In this case we simply
- -- rewrite the node with its expression since we don't need the actions
- -- and the specification of this node does not allow a null action list.
-
- -- Note: we use Rewrite instead of Replace, because Codepeer is using
- -- the expanded tree and relying on being able to retrieve the original
- -- tree in cases like this. This raises a whole lot of issues of whether
- -- we have problems elsewhere, which will be addressed in the future???
-
- if Is_Empty_List (Acts) then
+ Insert_Actions (N, Acts);
Rewrite (N, Relocate_Node (Expression (N)));
+ Analyze_And_Resolve (N, Typ);
+
+ -- Note that the result is never static
+
+ Set_Is_Static_Expression (N, False);
end if;
end Expand_N_Expression_With_Actions;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f25c46213bb..b28913eff70 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5374,6 +5374,12 @@ package body Exp_Ch6 is
-- cause a temporary to be created.
begin
+ -- The decision will be made after the EWA node is expanded
+
+ if Nkind (Par) = N_Expression_With_Actions then
+ return;
+ end if;
+
-- Optimization: if the returned value is returned again, then no need
-- to copy/readjust/finalize, we can just pass the value through (see
-- Expand_Simple_Function_Return), and thus no attachment is needed.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f25dc89d5fd..41d2d99d480 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -21050,10 +21050,10 @@ package body Sem_Ch3 is
-- Ada 2005 (AI-287, AI-318): Relax the strictness of the front end in
-- case of limited aggregates (including extension aggregates), and
-- function calls. The function call may have been given in prefixed
- -- notation, in which case the original node is an indexed component.
- -- If the function is parameterless, the original node was an explicit
- -- dereference. The function may also be parameterless, in which case
- -- the source node is just an identifier.
+ -- notation, in which case the original node is an indexed component,
+ -- or a selected component if the function is parameterless, or even
+ -- an explicit dereference. Finally, for a direct unprefixed call to
+ -- a parameterless function, the original node is just an identifier.
-- A branch of a conditional expression may have been removed if the
-- condition is statically known. This happens during expansion, and
@@ -21078,7 +21078,7 @@ package body Sem_Ch3 is
return Present (Entity (Original_Node (Exp)))
and then Ekind (Entity (Original_Node (Exp))) = E_Function;
- when N_Qualified_Expression =>
+ when N_Expression_With_Actions | N_Qualified_Expression =>
return
OK_For_Limited_Init_In_05
(Typ, Expression (Original_Node (Exp)));
--
2.53.0
