From: Ronan Desplanques Date: Fri, 4 Apr 2025 08:31:27 +0000 (+0200) Subject: ada: Fix wrong visibility over discriminants X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=647f34f8c1f5acbae5f752d8f0cb185ee1dade74;p=thirdparty%2Fgcc.git ada: Fix wrong visibility over discriminants This patch fixes an issue where the compiler was incorrectly allowing references to discriminants of the ancestor type in private type extensions. gcc/ada/ChangeLog: * sem_ch3.adb (Build_Derived_Private_Type): Fix test. (Build_Derived_Record_Type): Adjust error recovery paths. --- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 77426929379..5bc9b42e7ba 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -8508,11 +8508,19 @@ package body Sem_Ch3 is Analyze (Decl); - pragma Assert (Has_Discriminants (Full_Der) - and then not Has_Unknown_Discriminants (Full_Der)); + pragma + Assert + ((Has_Discriminants (Full_Der) + and then not Has_Unknown_Discriminants (Full_Der)) + or else Serious_Errors_Detected > 0); Uninstall_Declarations (Par_Scope); + if Etype (Full_Der) = Any_Type then + pragma Assert (Serious_Errors_Detected > 0); + return; + end if; + -- Freeze the underlying record view, to prevent generation of -- useless dispatching information, which is simply shared with -- the real derived type. @@ -9477,8 +9485,8 @@ package body Sem_Ch3 is if Constraint_Present then if not Has_Discriminants (Parent_Base) or else - (Has_Unknown_Discriminants (Parent_Base) - and then Is_Private_Type (Parent_Base)) + (Has_Unknown_Discriminants (Parent_Type) + and then Is_Private_Type (Parent_Type)) then Error_Msg_N ("invalid constraint: type has no discriminant",