exp_ch3.adb (Build_Initialization_Call): Apply predicate check to default discriminant value if checks are enabled.

2017-01-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Build_Initialization_Call): Apply predicate
	check to default discriminant value if checks are enabled.
	(Build_Assignment): If type of component has static predicate,
	apply check to its default value, if any.

From-SVN: r244147
This commit is contained in:
Ed Schonberg 2017-01-06 12:04:33 +00:00 committed by Arnaud Charlet
parent 73bfca7886
commit e666e74478
2 changed files with 29 additions and 0 deletions

View File

@ -1,3 +1,10 @@
2017-01-06 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Build_Initialization_Call): Apply predicate
check to default discriminant value if checks are enabled.
(Build_Assignment): If type of component has static predicate,
apply check to its default value, if any.
2017-01-06 Patrick Bernardi <bernardi@adacore.com>
* aspect.adb, aspect.ads: Added new aspect Secondary_Stack_Size.

View File

@ -1485,8 +1485,18 @@ package body Exp_Ch3 is
-- The constraints come from the discriminant default exps,
-- they must be reevaluated, so we use New_Copy_Tree but we
-- ensure the proper Sloc (for any embedded calls).
-- In addtion, if a predicate check is needed on the value
-- of the discriminant, insert it ahead of the call.
Arg := New_Copy_Tree (Arg, New_Sloc => Loc);
if Has_Predicates (Etype (Discr))
and then not Predicate_Checks_Suppressed (Empty)
and then not Predicates_Ignored (Etype (Discr))
then
Prepend_To (Res,
Make_Predicate_Check (Etype (Discr), Arg));
end if;
end if;
end if;
@ -1730,6 +1740,18 @@ package body Exp_Ch3 is
Typ => Etype (Id)));
end if;
-- If a component type has a predicate, add check to the component
-- assignment. Discriminants are hnndled at the point of the call,
-- which provides for a better error message.
if Comes_From_Source (Exp)
and then Has_Predicates (Typ)
and then not Predicate_Checks_Suppressed (Empty)
and then not Predicates_Ignored (Typ)
then
Append (Make_Predicate_Check (Typ, Exp), Res);
end if;
return Res;
exception