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 --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 9935625f1299b0c174a9827c30ce6a65b3dff8ec..48138e9988347b3e485e402d3f01343bb4951759 100644 (file)
--- 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 dfbe15b5d2a5325ca48f5d45ebdaa910d5590dc9..286b4612eb3be50941f34a216a82ab5c5bc56a50 100644 (file)
--- 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 146fd10202a5bc480a303efa336985bda68ef591..13b9163f459187bf73b6856cc099b6fd823b603e 100644 (file)
--- 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;