===================================================================
@@ -1355,8 +1355,13 @@
Apply_Range_Check (N, Typ);
+ -- Do not install a discriminant check for a constrained subtype
+ -- created for an unconstrained nominal type because the subtype
+ -- has the correct constraints by construction.
+
elsif Has_Discriminants (Base_Type (Desig_Typ))
- and then Is_Constrained (Desig_Typ)
+ and then Is_Constrained (Desig_Typ)
+ and then not Is_Constr_Subt_For_U_Nominal (Desig_Typ)
then
Apply_Discriminant_Check (N, Typ);
end if;
This patch suppresses the generation of a discriminant check when the associated type is a constrained subtype created for an unconstrained nominal type. The discriminant check is not needed because the subtype has the correct discriminants by construction. ------------ -- Source -- ------------ -- types.ads package Types is type Priv (<>) is tagged private; function Create (Val : Integer) return Priv; private type Priv (Discr : Integer) is tagged null record; end Types; -- types.adb package body Types is function Create (Val : Integer) return Priv is begin return Priv'(Discr => Val); end Create; end Types; -- main.adb with Types; use Types; procedure Main is function Create_Any return Priv'Class is begin return Result : Priv := Create (1234); end Create_Any; Obj : constant Priv'Class := Create_Any; begin null; end Main; ----------------- -- Compilation -- ----------------- $ gcc -c main.adb Tested on x86_64-pc-linux-gnu, committed on trunk 2017-05-02 Hristian Kirtchev <kirtchev@adacore.com> * checks.adb (Apply_Constraint_Check): Do not apply a discriminant check when the associated type is a constrained subtype created for an unconstrained nominal type.