This patch adds a discriminant check on actuals in a call, that are type
conversions of a constrained discriminated object to a constrained type.

Compiling and executing discr.adb  must yield:

   discr.adb:12:11: warning: incorrect value for discriminant "J"
   discr.adb:12:11: warning: "Constraint_Error" will be raised at run time

   raised CONSTRAINT_ERROR : discr.adb:12 discriminant check failed

---
procedure Discr is
   type R (J : Integer) is null record;
   type R10 is new R(10);

   procedure P (X : in out R10) is
   begin
      null;
   end P;

   X : R(0);
begin
   P (R10(X));
end Discr;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-01-24  Ed Schonberg  <schonb...@adacore.com>

        * sem_res.adb (Resolve_Actuals): If an actual is a view
        conversion of a discriminated object, and the formal type is
        discriminated and constrained, apply a discriminant check to
        the object itself.

Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 207034)
+++ sem_res.adb (working copy)
@@ -4041,6 +4041,16 @@
                then
                   Apply_Discriminant_Check (A, F_Typ);
 
+                  --  For view conversions of a discriminated object, apply
+                  --  check to object itself, the conversion alreay has the
+                  --  proper type.
+
+                  if Nkind (A) = N_Type_Conversion
+                    and then Is_Constrained (Etype (Expression (A)))
+                  then
+                     Apply_Discriminant_Check (Expression (A), F_Typ);
+                  end if;
+
                elsif Is_Access_Type (F_Typ)
                  and then Is_Array_Type (Designated_Type (F_Typ))
                  and then Is_Constrained (Designated_Type (F_Typ))

Reply via email to