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 <[email protected]>
* 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.
Index: checks.adb
===================================================================
--- checks.adb (revision 247466)
+++ checks.adb (working copy)
@@ -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;
