https://gcc.gnu.org/g:ee0bf66ed6c2acde588a4275df9c21cc8d67ff8d
commit r17-4597-gee0bf66ed6c2acde588a4275df9c21cc8d67ff8d Author: Eric Botcazou <[email protected]> Date: Wed Sep 23 11:06:06 2026 +0200 Ada: Fix derivation of constrained private type with defaulted discriminants 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. gcc/ada/ * 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. Diff: --- gcc/ada/sem_ch3.adb | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9aec12d24a70..504d77ce03b3 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
