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 ddc3f4d6181fbabe3794061062637e4c022f5c3c..24d56a13650072a3d42a27a90876032aa60f872d 100644 (file)
--- 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 06d378647124b183257f30821b15cc0ab15f4b23..219e67163690c5b230c6e1de7116ae1c452a5128 100644 (file)
--- 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,