diff options
author | Javier Miranda <miranda@adacore.com> | 2024-08-06 17:07:09 +0000 |
---|---|---|
committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-08-23 10:51:04 +0200 |
commit | 92a9b5527b21b7af8aaaa3cea8553d9b3224f29a (patch) | |
tree | 1617da9ce759d863c4deb6786fd8b88d978dc7bd /gcc | |
parent | 0020cae9fba4409c4c776129c3c45c27b79edf62 (diff) | |
download | gcc-92a9b5527b21b7af8aaaa3cea8553d9b3224f29a.zip gcc-92a9b5527b21b7af8aaaa3cea8553d9b3224f29a.tar.gz gcc-92a9b5527b21b7af8aaaa3cea8553d9b3224f29a.tar.bz2 |
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/sem_ch6.adb | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 008c3a7..461bdfc 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 |