From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 1 Oct 2012 10:24:00 +0000 (+0000)
Subject: checks.adb: Improve warning message.
X-Git-Tag: misc/gccgo-go1_1_2~520
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=3a0919e2fcf1a62ef251131295ce770c23ebe169;p=thirdparty%2Fgcc.git

checks.adb: Improve warning message.

2012-10-01  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb: Improve warning message.

From-SVN: r191915
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ddc3f4d6181f..24d56a136500 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,7 @@
+2012-10-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* checks.adb: Improve warning message.
+
 2012-10-01  Robert Dewar  <dewar@adacore.com>
 
 	* checks.adb: Minor reformatting.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 06d378647124..219e67163690 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2250,11 +2250,20 @@ package body Checks is
          if Present (S) and then Get_TSS_Name (S) /= TSS_Null then
             return;
 
-         --  Check certainly does not apply within the predicate function
-         --  itself, else we have a infinite recursion.
+         --  If the check appears within the predicate function itself, it
+         --  means that the user specified a check whose formal is the
+         --  predicated subtype itself, rather than some covering type. This
+         --  is likely to be a common error, and thus deserves a warning.
 
          elsif S = Predicate_Function (Typ) then
-            return;
+            Error_Msg_N
+              ("predicate check includes a function call that "
+               & "requires a predicate check?", Parent (N));
+            Error_Msg_N
+              ("\this will result in infinite recursion?", Parent (N));
+            Insert_Action (N,
+               Make_Raise_Storage_Error
+                 (Sloc (N), Reason => SE_Infinite_Recursion));
 
          else
             Insert_Action (N,