ada: Fix spurious error on Ada 2022 declare expression of limited type

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.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7279fe3cf769475eb15da23eaa5f3a0e22151661..fde321a0ba5415923815eb6b9be70b8f3c6cb5ed 100644 (file)
--- 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));
+      Temp_Decl : Node_Id;
+      Temp_Id   : Entity_Id;
+      Temp_Ref  : Node_Id;
 
-         Append (Flag_Decl, Acts);
-         Analyze (Flag_Decl);
+   --  Start of processing for Expand_N_Expression_With_Actions
 
-         --  Replace the expression with a reference to the flag
+   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).
 
-         Rewrite (Expression (N), New_Occurrence_Of (Flag_Id, Loc));
-         Analyze (Expression (N));
-      end Force_Boolean_Evaluation;
+      Apply_Constraint_Check (Expression (N), Typ);
 
-   --  Start of processing for Expand_N_Expression_With_Actions
+      --  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.
 
-   begin
-      --  Do not evaluate the expression when it denotes an entity because the
-      --  expression_with_actions node will be replaced by the reference.
+      --  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_Entity_Name (Expression (N)) then
-         null;
+      if Is_Empty_List (Acts) then
+         Rewrite (N, Relocate_Node (Expression (N)));
+         Analyze_And_Resolve (N, Typ);
 
-      --  Do not evaluate the expression when there are no actions because the
-      --  expression_with_actions node will be replaced by the expression.
+      --  Do not evaluate the expression when it denotes an entity because the
+      --  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.
 
-      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)));
 
-      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).
+         Append (Temp_Decl, Acts);
+         Analyze (Temp_Decl);
 
-         Apply_Constraint_Check (Expression (N), Etype (N));
-         Force_Evaluation (Expression (N));
-      end if;
+         Temp_Ref := New_Occurrence_Of (Temp_Id, Loc);
 
-      --  Process transient objects found within the actions of the EWA node
+         --  Copy the Do_Range_Check flag that may have been set above
 
-      Process_Transients_In_Expression (N, Acts);
+         Set_Do_Range_Check (Temp_Ref, Do_Range_Check (Expression (N)));
 
-      --  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.
+         --  Replace the expression with a reference to the temporary
 
-      --  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???
+         Rewrite (Expression (N), Temp_Ref);
 
-      if Is_Empty_List (Acts) then
+         --  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
+         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 f25c46213bb03646760c9f1caffbb9af688427bf..b28913eff709a0f0ffa5e882a3c4add7277a1664 100644 (file)
--- 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 f25dc89d5fd901fc7d939d4881b2e63b63b1423f..41d2d99d480e4fa6edc5d0354f7d5a7d493ddf1f 100644 (file)
--- 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)));