https://gcc.gnu.org/g:2eb64c5b1b9c28a48937b5e8ab3cd36b0d1149f2
commit r16-6613-g2eb64c5b1b9c28a48937b5e8ab3cd36b0d1149f2 Author: Martin Clochard <[email protected]> Date: Mon Nov 3 10:19:08 2025 +0100 ada: Move detection of anonymous access types in expansion of Old attributes Expansion of the Old attribute with anonymous access type is treated as a special case as the implicit constants need to be declared the same way as for conditionally evaluated Old attributes. However, this was implemented in a way that produced evaluation guards even when the attribute was supposed to be unconditionally evaluated. gcc/ada/ChangeLog: * exp_attr.adb (Expand_N_Attribute_Reference): For Old attribute, detect the anonymous access type case explicitly instead of implicitly within in Eligible_For_Conditional_Evaluation. * sem_util.ads: (Eligible_For_Conditional_Evaluation): Do not return True on anonymous access types. This was also breaking usage outside expansion (legality checks for Old). * sem_util.adb: (Conditional_Evaluation_Condition): Special case of no determiners for anonymous access types is no longer possible. Diff: --- gcc/ada/exp_attr.adb | 40 ++++++++++++++++++++++++++++------------ gcc/ada/sem_util.adb | 12 ++---------- gcc/ada/sem_util.ads | 4 ---- 3 files changed, 30 insertions(+), 26 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 9935625f1299..48138e998834 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5581,14 +5581,18 @@ package body Exp_Attr is --------- when Attribute_Old => Old : declare - CW_Temp : Entity_Id; - CW_Typ : Entity_Id; - Decl : Node_Id; - Ins_Nod : Node_Id; - Temp : Entity_Id; + CW_Temp : Entity_Id; + CW_Typ : Entity_Id; + Decl : Node_Id; + Ins_Nod : Node_Id; + Temp : Entity_Id; use Old_Attr_Util.Conditional_Evaluation; use Old_Attr_Util.Indirect_Temps; + + Cond_Eval : constant Boolean := + Eligible_For_Conditional_Evaluation (N); + begin -- 'Old can only appear in the case where local contract-related -- wrapper has been generated with the purpose of wrapping the @@ -5617,7 +5621,12 @@ package body Exp_Attr is Ins_Nod := Last (Declarations (Ins_Nod)); - if Eligible_For_Conditional_Evaluation (N) then + -- The code that builds declarations for always evaluated 'Old + -- constants doesn't handle the anonymous access type case correctly. + -- Indirect temporaries do, so we avoid that problem by going through + -- the same code as for conditionally evaluated constants. + + if Cond_Eval or else Is_Anonymous_Access_Type (Etype (N)) then declare Eval_Stmts : constant List_Id := New_List; @@ -5649,12 +5658,19 @@ package body Exp_Attr is Declare_Indirect_Temporary (Attr_Prefix => Pref, Indirect_Temp => Temp); - Insert_After_And_Analyze ( - Ins_Nod, - Make_If_Statement - (Sloc => Loc, - Condition => Conditional_Evaluation_Condition (N), - Then_Statements => Eval_Stmts)); + -- Prefixes with anonymous access type might be unconditionally + -- evaluated. + + if Cond_Eval then + Insert_After_And_Analyze ( + Ins_Nod, + Make_If_Statement + (Sloc => Loc, + Condition => Conditional_Evaluation_Condition (N), + Then_Statements => Eval_Stmts)); + else + Insert_List_After_And_Analyze (Ins_Nod, Eval_Stmts); + end if; Rewrite (N, Indirect_Temp_Value (Temp => Temp, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index dfbe15b5d2a5..286b4612eb3b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -31520,8 +31520,7 @@ package body Sem_Util is Result : Node_Id := New_Occurrence_Of (Standard_True, Loc); begin - pragma Assert (Determiners'Length > 0 or else - Is_Anonymous_Access_Type (Etype (Expr))); + pragma Assert (Determiners'Length > 0); for I in Determiners'Range loop Result := Make_And_Then @@ -31735,14 +31734,7 @@ package body Sem_Util is (Expr : Node_Id) return Boolean is begin - if Is_Anonymous_Access_Type (Etype (Expr)) then - -- The code in exp_attr.adb that also builds declarations - -- for 'Old constants doesn't handle the anonymous access - -- type case correctly, so we avoid that problem by - -- returning True here. - return True; - - elsif Ada_Version < Ada_2022 then + if Ada_Version < Ada_2022 then return False; elsif Inside_Class_Condition_Preanalysis then diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 146fd10202a5..13b9163f4591 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -3635,10 +3635,6 @@ package Sem_Util is -- - its determining expressions are all known on entry; and -- - Ada_Version >= Ada_2022. -- See RM 6.1.1 for definitions of these terms. - -- - -- Also returns True if Expr is of an anonymous access type; - -- this is just because we want the code that knows how to build - -- 'Old temps in that case to reside in only one place. function Conditional_Evaluation_Condition (Expr : Node_Id) return Node_Id;
