The problem is that the Has_Constrained_Partial_View flag is not inherited
by derived types.  Since it is set both on the partial and full views, both
Build_Derived_Private_Type and Build_Derived_Record_Type need to be fixed.

Tested on x86-64/Linux, applied on the mainline.


2026-09-23  Eric Botcazou  <[email protected]>

        * sem_ch3.adb (Build_Derived_Private_Type): In the case where the
        partial view has none but the full view has discriminants, do not
        set again the Etype, propagate the Has_Constrained_Partial_View
        flag from the parent base type and the Is_Constrained flag from
        the partial view of the parent type.
        (Build_Derived_Record_Type): Propagate Has_Constrained_Partial_View
        from the parent base type.

-- 
Eric Botcazou
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9aec12d24a7..504d77ce03b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8709,8 +8709,6 @@ package body Sem_Ch3 is
          --  In any case, the primitive operations are inherited from the
          --  parent type, not from the internal full view.
 
-         Set_Etype (Base_Type (Derived_Type), Base_Type (Parent_Type));
-
          if Derive_Subps then
             --  Initialize the list of primitive operations to an empty list,
             --  to cover tagged types as well as untagged types. For untagged
@@ -8722,12 +8720,13 @@ package body Sem_Ch3 is
             Derive_Subprograms (Parent_Type, Derived_Type);
          end if;
 
+         Set_Has_Constrained_Partial_View
+           (Derived_Type, Has_Constrained_Partial_View (Par_Base));
+         Set_Is_Constrained (Derived_Type, Is_Constrained (Parent_Type));
          Set_Stored_Constraint (Derived_Type, No_Elist);
-         Set_Is_Constrained
-           (Derived_Type, Is_Constrained (Available_Full_View (Parent_Type)));
 
       else
-         --  Untagged type, No discriminants on either view
+         --  Untagged type, no discriminants on either view
 
          if Nkind (Subtype_Indication (Type_Definition (N))) =
                                                    N_Subtype_Indication
@@ -10075,6 +10074,8 @@ package body Sem_Ch3 is
       Propagate_Concurrent_Flags (Derived_Type, Parent_Base);
       Propagate_Controlled_Flags (Derived_Type, Parent_Base, Deriv => True);
 
+      Set_Has_Constrained_Partial_View
+        (Derived_Type, Has_Constrained_Partial_View (Parent_Base));
       Set_Has_Non_Standard_Rep
         (Derived_Type, Has_Non_Standard_Rep     (Parent_Base));
       Set_Has_Primitive_Operations

Reply via email to