From: Ed Schonberg <schonberg@adacore.com>
Date: Fri, 6 Jan 2017 12:04:33 +0000 (+0000)
Subject: exp_ch3.adb (Build_Initialization_Call): Apply predicate check to default discriminan... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e666e744789bce7e018bafd8893bac3fa27903d8;p=gcc.git

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
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3be774d8172..ad4f3ca647f 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 ae2ed500f9a..e617c0540f8 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