exp_ch3.adb (Build_Initialization_Call): Apply predicate check to default discriminan...

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3be774d..ad4f3ca 100644 (file)
--- 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 (file)
--- 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