summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2023-01-26 19:39:31 +0000
committerMarc Poulhiès <poulhies@adacore.com>2023-05-16 10:30:58 +0200
commit072861beb9bcc6cbf2e16aafe6b0aae049d60989 (patch)
treec99c7a17fabf6cc49fbbadc192cbdc9dc132dd39
parentb979a474167624bf658fd30a23e99f087d7c6e0a (diff)
downloadgcc-072861beb9bcc6cbf2e16aafe6b0aae049d60989.tar.gz
ada: Spurious error analyzing 'old or 'result in class-wide conditions
gcc/ada/ * sem_attr.adb (Analyze_Attribute_Old_Result): When preanalyzing a class-wide condition, search in the scopes stack for the subprogram that has the condition. This is required because returning the current scope causes reporting spurious errors when the occurrence of the attribute is found, for example, in a quantified expression.
-rw-r--r--gcc/ada/sem_attr.adb23
1 files changed, 21 insertions, 2 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 452aabdd436..a07e91b839d 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1366,8 +1366,27 @@ package body Sem_Attr is
-- yet on its definite context.
if Inside_Class_Condition_Preanalysis then
- Legal := True;
- Spec_Id := Current_Scope;
+ Legal := True;
+
+ -- Search for the subprogram that has this class-wide condition;
+ -- required to avoid reporting spurious errors since the current
+ -- scope may not be appropriate because the attribute may be
+ -- referenced from the inner scope of, for example, quantified
+ -- expressions.
+
+ -- Although the expression is not installed on its definite
+ -- context, we know that the subprogram has been placed in the
+ -- scope stack by Preanalyze_Condition; we also know that it is
+ -- not a generic subprogram since class-wide pre/postconditions
+ -- can only be applied for primitive operations of tagged types.
+
+ if Is_Subprogram (Current_Scope) then
+ Spec_Id := Current_Scope;
+ else
+ Spec_Id := Enclosing_Subprogram (Current_Scope);
+ end if;
+
+ pragma Assert (Is_Dispatching_Operation (Spec_Id));
return;
end if;