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 <[email protected]>
* 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))
