[multiple changes]

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch4.adb (Analyze_Quantified_Expression):
	Add local variable Loop_Id. Verify that the loop variable
	is used within the condition of the quantified expression.
	(Referenced): New routine.

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_case.adb (Analyze_Choices): Enhance the error message
	given on a bad use of subtype predicate.
	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Enhance
	the error message given on a bad use of subtype predicate.
	* sem_util.adb (Bad_Predicated_Subtype_Use): Add formal parameter
	Suggest_Static. Emit an extra error message advising how to
	remedy the bad use of the predicate if the context warrants it.
	* sem_util.ads (Bad_Predicated_Subtype_Use): Add formal parameter
	Suggest_Static along with a comment explaining its usage.

2013-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_disp.adb (Check_Dispatching_Operation): Further refinement
	to checks for AI05-0125: the check for a hidden primitive that
	may be overridden by the new declaration only applies if the
	hidden operation is never declared. This is not the case if the
	operation is declared in a parent unit.

From-SVN: r198288

7 files changed, 117 insertions, 21 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d40d2eb..a3e8f83 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch4.adb (Analyze_Quantified_Expression):
+	Add local variable Loop_Id. Verify that the loop variable
+	is used within the condition of the quantified expression.
+	(Referenced): New routine.
+
+2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_case.adb (Analyze_Choices): Enhance the error message
+	given on a bad use of subtype predicate.
+	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Enhance
+	the error message given on a bad use of subtype predicate.
+	* sem_util.adb (Bad_Predicated_Subtype_Use): Add formal parameter
+	Suggest_Static. Emit an extra error message advising how to
+	remedy the bad use of the predicate if the context warrants it.
+	* sem_util.ads (Bad_Predicated_Subtype_Use): Add formal parameter
+	Suggest_Static along with a comment explaining its usage.
+
+2013-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_disp.adb (Check_Dispatching_Operation): Further refinement
+	to checks for AI05-0125: the check for a hidden primitive that
+	may be overridden by the new declaration only applies if the
+	hidden operation is never declared. This is not the case if the
+	operation is declared in a parent unit.
+
 2013-04-25  Robert Dewar  <dewar@adacore.com>
 
 	* debug.adb: Remove d.X and d.Y entries and documentation.
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 6f066fe..515d2a6 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -1260,7 +1260,8 @@ package body Sem_Case is
                            then
                               Bad_Predicated_Subtype_Use
                                 ("cannot use subtype& with non-static "
-                                 & "predicate as case alternative", Choice, E);
+                                 & "predicate as case alternative", Choice, E,
+                                 Suggest_Static => True);
 
                               --  Static predicate case
 
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 2fa9c5a..d54d992 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3510,6 +3510,9 @@ package body Sem_Ch4 is
       --  Determine whether if expression If_Expr lacks an else part or if it
       --  has one, it evaluates to True.
 
+      function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean;
+      --  Determine whether entity Id is referenced within expression Expr
+
       --------------------
       -- Is_Empty_Range --
       --------------------
@@ -3561,9 +3564,44 @@ package body Sem_Ch4 is
                        and then Is_True (Expr_Value (Else_Expr)));
       end No_Else_Or_Trivial_True;
 
+      ----------------
+      -- Referenced --
+      ----------------
+
+      function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is
+         Seen : Boolean := False;
+
+         function Is_Reference (N : Node_Id) return Traverse_Result;
+         --  Determine whether node N denotes a reference to Id. If this is the
+         --  case, set global flag Seen to True and stop the traversal.
+
+         function Is_Reference (N : Node_Id) return Traverse_Result is
+         begin
+            if Is_Entity_Name (N)
+              and then Present (Entity (N))
+              and then Entity (N) = Id
+            then
+               Seen := True;
+               return Abandon;
+            else
+               return OK;
+            end if;
+         end Is_Reference;
+
+         procedure Inspect_Expression is new Traverse_Proc (Is_Reference);
+
+      --  Start of processing for Referenced
+
+      begin
+         Inspect_Expression (Expr);
+
+         return Seen;
+      end Referenced;
+
       --  Local variables
 
       Cond    : constant Node_Id := Condition (N);
+      Loop_Id : Entity_Id;
       QE_Scop : Entity_Id;
 
    --  Start of processing for Analyze_Quantified_Expression
@@ -3590,22 +3628,39 @@ package body Sem_Ch4 is
       if Present (Iterator_Specification (N)) then
          Preanalyze (Iterator_Specification (N));
 
+         --  Do not proceed with the analysis when the range of iteration is
+         --  empty. The appropriate error is issued by Is_Empty_Range.
+
          if Is_Entity_Name (Name (Iterator_Specification (N)))
            and then Is_Empty_Range (Etype (Name (Iterator_Specification (N))))
          then
             return;
          end if;
 
-      else
+      else pragma Assert (Present (Loop_Parameter_Specification (N)));
          Preanalyze (Loop_Parameter_Specification (N));
       end if;
 
       Preanalyze_And_Resolve (Cond, Standard_Boolean);
 
       End_Scope;
-
       Set_Etype (N, Standard_Boolean);
 
+      --  Verify that the loop variable is used within the condition of the
+      --  quantified expression.
+
+      if Present (Iterator_Specification (N)) then
+         Loop_Id := Defining_Identifier (Iterator_Specification (N));
+      else
+         Loop_Id := Defining_Identifier (Loop_Parameter_Specification (N));
+      end if;
+
+      if Warn_On_Suspicious_Contract
+        and then not Referenced (Loop_Id, Cond)
+      then
+         Error_Msg_N ("?T?unused variable &", Loop_Id);
+      end if;
+
       --  Diagnose a possible misuse of the "some" existential quantifier. When
       --  we have a quantified expression of the form
       --
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index b2ed158..5b34ecc 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2310,7 +2310,7 @@ package body Sem_Ch5 is
          then
             Bad_Predicated_Subtype_Use
               ("cannot use subtype& with non-static predicate for loop " &
-               "iteration", DS, Entity (DS));
+               "iteration", DS, Entity (DS), Suggest_Static => True);
          end if;
       end if;
 
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 8d779b2..9f80a7d 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -44,6 +44,7 @@ with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch6;  use Sem_Ch6;
+with Sem_Ch8;  use Sem_Ch8;
 with Sem_Eval; use Sem_Eval;
 with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;
@@ -1867,12 +1868,14 @@ package body Sem_Disp is
       Vis_List  : Elist_Id;
 
    begin
-      --  This Ada 2012 rule is valid only for type extensions or private
-      --  extensions.
+      --  This Ada 2012 rule applies only for type extensions or private
+      --  extensions, where the parent type is not in a parent unit, and
+      --  where an operation is never declared but still inherited.
 
       if No (Tag_Typ)
         or else not Is_Record_Type (Tag_Typ)
         or else Etype (Tag_Typ) = Tag_Typ
+        or else In_Open_Scopes (Scope (Etype (Tag_Typ)))
       then
          return Empty;
       end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index bf032fd..dbee4fd 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -449,9 +449,10 @@ package body Sem_Util is
    --------------------------------
 
    procedure Bad_Predicated_Subtype_Use
-     (Msg : String;
-      N   : Node_Id;
-      Typ : Entity_Id)
+     (Msg            : String;
+      N              : Node_Id;
+      Typ            : Entity_Id;
+      Suggest_Static : Boolean := False)
    is
    begin
       if Has_Predicates (Typ) then
@@ -465,6 +466,13 @@ package body Sem_Util is
          else
             Error_Msg_FE (Msg, N, Typ);
          end if;
+
+         --  Emit an optional suggestion on how to remedy the error if the
+         --  context warrants it.
+
+         if Suggest_Static and then Present (Static_Predicate (Typ)) then
+            Error_Msg_FE ("\predicate of & should be marked static", N, Typ);
+         end if;
       end if;
    end Bad_Predicated_Subtype_Use;
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index fd9b940..c9b5da6 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -122,19 +122,21 @@ package Sem_Util is
    --  is an error.
 
    procedure Bad_Predicated_Subtype_Use
-     (Msg : String;
-      N   : Node_Id;
-      Typ : Entity_Id);
+     (Msg            : String;
+      N              : Node_Id;
+      Typ            : Entity_Id;
+      Suggest_Static : Boolean := False);
    --  This is called when Typ, a predicated subtype, is used in a context
-   --  which does not allow the use of a predicated subtype. Msg is passed
-   --  to Error_Msg_FE to output an appropriate message using N as the
-   --  location, and Typ as the entity. The caller must set up any insertions
-   --  other than the & for the type itself. Note that if Typ is a generic
-   --  actual type, then the message will be output as a warning, and a
-   --  raise Program_Error is inserted using Insert_Action with node N as
-   --  the insertion point. Node N also supplies the source location for
-   --  construction of the raise node. If Typ is NOT a type with predicates
-   --  this call has no effect.
+   --  which does not allow the use of a predicated subtype. Msg is passed to
+   --  Error_Msg_FE to output an appropriate message using N as the location,
+   --  and Typ as the entity. The caller must set up any insertions other than
+   --  the & for the type itself. Note that if Typ is a generic actual type,
+   --  then the message will be output as a warning, and a raise Program_Error
+   --  is inserted using Insert_Action with node N as the insertion point. Node
+   --  N also supplies the source location for construction of the raise node.
+   --  If Typ does not have any predicates, the call has no effect. Set flag
+   --  Suggest_Static when the context warrants an advice on how to avoid the
+   --  use error.
 
    function Build_Actual_Subtype
      (T : Entity_Id;