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 Botcazoudiff --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