From: Gary Dismukes <dismukes@adacore.com>
Date: Tue, 6 Nov 2012 10:22:42 +0000 (+0000)
Subject: exp_attr.adb (Expand_N_Attribute_Reference): Apply a predicate check when evaluating... 
X-Git-Tag: upstream/12.2.0~73031
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3d6db7f84dd4dd52ebc9436b462f599d9fb0564b;p=platform%2Fupstream%2Fgcc.git

exp_attr.adb (Expand_N_Attribute_Reference): Apply a predicate check when evaluating the attribute Valid...

2012-11-06  Gary Dismukes  <dismukes@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Apply a predicate
	check when evaluating the attribute Valid, and issue a warning
	about infinite recursion when the check occurs within the
	predicate function of the prefix's subtype.
	* exp_ch4.adb (Expand_N_In): Remove test for Is_Discrete_Type
	when we're checking that there's no predicate check function as a
	condition for substituting a Valid check for a scalar membership
	test (substitution should be suppressed for any kind of scalar
	subtype with a predicate check). Also, don't emit a predicate
	check when the right operand is a range.

From-SVN: r193228
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e3c04aa..7493c6d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2012-11-06  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference): Apply a predicate
+	check when evaluating the attribute Valid, and issue a warning
+	about infinite recursion when the check occurs within the
+	predicate function of the prefix's subtype.
+	* exp_ch4.adb (Expand_N_In): Remove test for Is_Discrete_Type
+	when we're checking that there's no predicate check function as a
+	condition for substituting a Valid check for a scalar membership
+	test (substitution should be suppressed for any kind of scalar
+	subtype with a predicate check). Also, don't emit a predicate
+	check when the right operand is a range.
+
 2012-11-06  Robert Dewar  <dewar@adacore.com>
 
 	* par_sco.adb, bindgen.adb, exp_vfpt.adb, exp_vfpt.ads, exp_ch2.adb,
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 417bad9..d94ae88 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -27,6 +27,7 @@ with Atree;    use Atree;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
+with Errout;   use Errout;
 with Exp_Atag; use Exp_Atag;
 with Exp_Ch2;  use Exp_Ch2;
 with Exp_Ch3;  use Exp_Ch3;
@@ -5608,6 +5609,32 @@ package body Exp_Attr is
             Rewrite (N, Make_Range_Test);
          end if;
 
+         --  If a predicate is present, then we do the predicate test, even if
+         --  within the predicate function (infinite recursion is warned about
+         --  in that case).
+
+         declare
+            Pred_Func : constant Entity_Id := Predicate_Function (Ptyp);
+
+         begin
+            if Present (Pred_Func) then
+               Rewrite (N,
+                 Make_And_Then (Loc,
+                   Left_Opnd  => Relocate_Node (N),
+                   Right_Opnd => Make_Predicate_Call (Ptyp, Pref)));
+
+               --  If the attribute appears within the subtype's own predicate
+               --  function, then issue a warning that this will cause infinite
+               --  recursion.
+
+               if Current_Scope = Pred_Func then
+                  Error_Msg_N
+                    ("attribute Valid requires a predicate check?", N);
+                  Error_Msg_N ("\and will result in infinite recursion?", N);
+               end if;
+            end if;
+         end;
+
          Analyze_And_Resolve (N, Standard_Boolean);
          Validity_Checks_On := Save_Validity_Checks_On;
       end Valid;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index ebdbcde..d9bdebd 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5565,8 +5565,7 @@ package body Exp_Ch4 is
         --  Skip this for predicated types, where such expressions are a
         --  reasonable way of testing if something meets the predicate.
 
-        and then not (Is_Discrete_Type (Ltyp)
-                       and then Present (Predicate_Function (Ltyp)))
+        and then not Present (Predicate_Function (Ltyp))
       then
          Substitute_Valid_Check;
          return;
@@ -6103,6 +6102,9 @@ package body Exp_Ch4 is
       --  If a predicate is present, then we do the predicate test, but we
       --  most certainly want to omit this if we are within the predicate
       --  function itself, since otherwise we have an infinite recursion!
+      --  The check should also not be emitted when testing against a range
+      --  (the check is only done when the right operand is a subtype; see
+      --  RM12-4.5.2 (28.1/3-30/3)).
 
       declare
          PFunc : constant Entity_Id := Predicate_Function (Rtyp);
@@ -6110,6 +6112,7 @@ package body Exp_Ch4 is
       begin
          if Present (PFunc)
            and then Current_Scope /= PFunc
+           and then Nkind (Rop) /= N_Range
          then
             Rewrite (N,
               Make_And_Then (Loc,