diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2017-01-06 12:04:33 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-01-06 13:04:33 +0100 |
| commit | e666e744789bce7e018bafd8893bac3fa27903d8 (patch) | |
| tree | 62f1c0eee4786a70aa5f282870c93f612e069453 /gcc | |
| parent | 73bfca7886a32ab7b806b6c8f7dc32663f83b44a (diff) | |
| download | gcc-e666e744789bce7e018bafd8893bac3fa27903d8.zip gcc-e666e744789bce7e018bafd8893bac3fa27903d8.tar.gz gcc-e666e744789bce7e018bafd8893bac3fa27903d8.tar.bz2 | |
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
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 22 |
2 files changed, 29 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3be774d..ad4f3ca 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index ae2ed50..e617c05 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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 |