From 3b0af59dc9e67f5161e0ac6a867429f6fd40308e Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 9 Jun 2026 11:11:54 +0200 Subject: [PATCH] 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. --- gcc/ada/exp_ch4.adb | 154 ++++++++++++++++++++++++++------------------ gcc/ada/exp_ch6.adb | 6 ++ gcc/ada/sem_ch3.adb | 10 +-- 3 files changed, 103 insertions(+), 67 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)); + 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 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.47.3