https://gcc.gnu.org/g:92a9b5527b21b7af8aaaa3cea8553d9b3224f29a
commit r15-3109-g92a9b5527b21b7af8aaaa3cea8553d9b3224f29a
Author: Javier Miranda <mira...@adacore.com>
Date: Tue Aug 6 17:07:09 2024 +0000
ada: First controlling parameter aspect
gcc/ada/
* sem_ch6.adb (Check_Private_Overriding): Improve code detecting
error on private function with controlling result. Fixes the
regression of ACATS bde0003.
Diff:
---
gcc/ada/sem_ch6.adb | 14 ++++++++++++--
1 file changed, 12 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 008c3a7ba139..461bdfcbe4b0 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11535,8 +11535,16 @@ package body Sem_Ch6 is
-- operation. That's illegal in the tagged case
-- (but not if the private type is untagged).
+ -- Do not report this error when the tagged type has
+ -- the First_Controlling_Parameter aspect, unless the
+ -- function has a controlling result (which is only
+ -- possible if the function overrides an inherited
+ -- primitive).
+
if T = Base_Type (Etype (S))
- and then Has_Controlling_Result (S)
+ and then
+ (not Has_First_Controlling_Parameter_Aspect (T)
+ or else Has_Controlling_Result (S))
then
Error_Msg_N
("private function with controlling result must"
@@ -11550,7 +11558,9 @@ package body Sem_Ch6 is
elsif Ekind (Etype (S)) = E_Anonymous_Access_Type
and then T = Base_Type (Designated_Type (Etype (S)))
- and then Has_Controlling_Result (S)
+ and then
+ (not Has_First_Controlling_Parameter_Aspect (T)
+ or else Has_Controlling_Result (S))
and then Ada_Version >= Ada_2012
then
Error_Msg_N
