[Ada] enchance machinery which detects redundant qualifications

[Arnaud Charlet]

Tested on i686-linux, committed on trunk

This patch enchances the machinery which detects redundant qualifications
Source:
   procedure T is
      type New_Positive is new Positive;
      procedure Y (V : New_Positive) is begin null; end Y;
      P     : constant Positive := 1;
      New_P : constant New_Positive := 2;
   begin
      Y (New_Positive (New_P));
      for Loop_New_P in 1 .. New_P loop
         Y (Loop_New_P);
         Y (New_Positive (Loop_New_P));
         Y (New_Positive'(New_P));
         Y (New_Positive'(Loop_New_P));
      end loop;
   end T;
Compilation:
   gnatmake -gnatwr t.adb
Output:
   t.adb:7:10: warning: redundant conversion, "New_P" is of type "New_Positive"
   t.adb:10:13: warning: redundant conversion, "Loop_New_P" is of type "New_Positive"

2007-08-31  Hristian Kirtchev  <kirtchev@adacore.com>

        * restrict.adb, namet.adb, par-util.adb: Remove redundant type
	conversion.

	* sem_res.adb (Resolve_Qualified_Expression): Add machinery to detect
	simple redundant qualifications. The check is performed whenever the
	expression is a non-overloaded identifier.
	(Resolve_Type_Conversion): Enchance the redundant type conversion check
	to include loop parameters.
	(Valid_Conversion): Avoid generation of spurious error message.

-------------- next part --------------
Index: restrict.adb
===================================================================
--- restrict.adb	(revision 127923)
+++ restrict.adb	(working copy)
@@ -99,7 +99,7 @@ package body Restrict is
         and then not Suppress_Restriction_Message (N)
       then
          Namet.Unlock;
-         Check_Restriction (Restriction_Id'(No_Elaboration_Code), N);
+         Check_Restriction (No_Elaboration_Code, N);
          Namet.Lock;
       end if;
    end Check_Elaboration_Code_Allowed;
@@ -110,7 +110,7 @@ package body Restrict is
 
    procedure Check_No_Implicit_Heap_Alloc (N : Node_Id) is
    begin
-      Check_Restriction (Restriction_Id'(No_Implicit_Heap_Allocations), N);
+      Check_Restriction (No_Implicit_Heap_Allocations, N);
    end Check_No_Implicit_Heap_Alloc;
 
    ---------------------------
Index: namet.adb
===================================================================
--- namet.adb	(revision 127923)
+++ namet.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -149,7 +149,7 @@ package body Namet is
 
             else
                Write_Str ("Hash_Table (");
-               Write_Int (Int (J));
+               Write_Int (J);
                Write_Str (") has ");
 
                declare
Index: par-util.adb
===================================================================
--- par-util.adb	(revision 127923)
+++ par-util.adb	(working copy)
@@ -61,7 +61,7 @@ package body Util is
       end if;
 
       for J in S'Range loop
-         S (J) := Fold_Lower (Tname (Integer (J) + 4));
+         S (J) := Fold_Lower (Tname (J + 4));
       end loop;
 
       Get_Name_String (Token_Name);
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 127923)
+++ sem_res.adb	(working copy)
@@ -7582,10 +7582,15 @@ package body Sem_Res is
          end if;
 
          if Is_Entity_Name (Orig_N)
-           and then Etype (Entity (Orig_N)) = Orig_T
+           and then
+             (Etype (Entity (Orig_N)) = Orig_T
+                or else
+                  (Ekind (Entity (Orig_N)) = E_Loop_Parameter
+                     and then Covers (Orig_T, Etype (Entity (Orig_N)))))
          then
+            Error_Msg_Node_2 := Orig_T;
             Error_Msg_NE
-              ("?useless conversion, & has this type!", N, Entity (Orig_N));
+              ("?redundant conversion, & is of type &!", N, Entity (Orig_N));
          end if;
       end if;
 
@@ -8803,9 +8808,14 @@ package body Sem_Res is
                     ("\?Program_Error will be raised at run time", Operand);
 
                else
-                  Error_Msg_N
-                    ("cannot convert local pointer to non-local access type",
-                     Operand);
+                  --  Avoid generation of spurious error message
+
+                  if not Error_Posted (N) then
+                     Error_Msg_N
+                      ("cannot convert local pointer to non-local access type",
+                       Operand);
+                  end if;
+
                   return False;
                end if;