From: Javier Miranda Date: Tue, 6 Aug 2024 17:07:09 +0000 (+0000) Subject: ada: First controlling parameter aspect X-Git-Tag: basepoints/gcc-16~6444 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=92a9b5527b21b7af8aaaa3cea8553d9b3224f29a;p=thirdparty%2Fgcc.git 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 --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 008c3a7ba13..461bdfcbe4b 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