From: Martin Clochard <[email protected]>
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.
Tested on x86_64-pc-linux-gnu (before the recent bootstrap breakage), committed
on master.
---
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 9935625f129..48138e99883 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 dfbe15b5d2a..286b4612eb3 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 146fd10202a..13b9163f459 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;
--
2.51.0
