[gcc r15-9825] ada: Fix wrong visibility over discriminants

[Eric Botcazou]

https://gcc.gnu.org/g:3a4d64e1a81da321ecfda326fa541f3ea9bd6c5b

commit r15-9825-g3a4d64e1a81da321ecfda326fa541f3ea9bd6c5b
Author: Ronan Desplanques <desplanques@adacore.com>
Date:   Fri Apr 4 10:31:27 2025 +0200

    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:
---
 gcc/ada/sem_ch3.adb | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9a25ff7b6405..e94b0434b90e 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8488,11 +8488,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.
@@ -9457,8 +9465,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",