]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix wrong visibility over discriminants
authorRonan Desplanques <desplanques@adacore.com>
Fri, 4 Apr 2025 08:31:27 +0000 (10:31 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Thu, 12 Jun 2025 08:37:55 +0000 (10:37 +0200)
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.

gcc/ada/sem_ch3.adb

index 77426929379fa351c9700831ebea426c560190d1..5bc9b42e7bad290f292b0925efe90ced0ba3415a 100644 (file)
@@ -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",