[Ada] Additional warnings on redundant use clauses in subprogram bodies.

[Ada] Additional warnings on redundant use clauses in subprogram bodies.

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 1276 bytes --]

Tested on i686-linux, committed on trunk

The circuitry that detects redundant use clauses did not examine subprogram
bodies and subunits, where a use clause in the body may be redundant because
of a use clause in the context of the unit.

the command
gcc -c -gnatwa toto.adb

must produce:

toto.adb:3:11:
warning: "Text_IO" is already use-visible through previous use clause at line 1

with Ada.Text_IO; use Ada.Text_IO;
procedure Toto is
   use Ada.Text_IO;
begin
   Put_Line ("hello world!");
end Toto;

Also, it is legal to declare stream attributes for interface types.
The corresponding
operations are abstract or null. Previous code only handled primitive functions
of abstract types. In the case of interfaces, all stream operations are made
abstract by default, to ensure that they are properly overriden in all its
descendents, and all of them can be overriden with another primitive.

See gnat.dg/tf_interface_1.ad[sb]

2008-05-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb
	(Note_Redundant_Use): Diagnose a redundant use within a subprogram body
	when there is a use clause for the same entity in the context.
	(Analyze_Subprogram_Renaming): A renaming_as_body is legal if it is
	created for a stream attribute of an abstract type or interface type.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 6077 bytes --]

Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 134945)
+++ sem_ch8.adb	(working copy)
@@ -1721,24 +1721,28 @@ package body Sem_Ch8 is
 
          Set_Corresponding_Spec (N, Rename_Spec);
 
-         --  Deal with special case of Input and Output stream functions
+         --  Deal with special case of stream functions of abstract types
+         --  and interfaces.
 
          if Nkind (Unit_Declaration_Node (Rename_Spec)) =
                                      N_Abstract_Subprogram_Declaration
          then
-            --  Input and Output stream functions are abstract if the object
-            --  type is abstract. However, these functions may receive explicit
-            --  declarations in representation clauses, making the attribute
-            --  subprograms usable  as defaults in subsequent type extensions.
+            --  Input stream functions are abstract if the object type is
+            --  abstract. Similarly, all default stream functions for an
+            --  interface type are abstract. However, these suprograms may
+            --  receive explicit declarations in representation clauses, making
+            --  the attribute subprograms usable as defaults in subsequent
+            --  type extensions.
             --  In this case we rewrite the declaration to make the subprogram
             --  non-abstract. We remove the previous declaration, and insert
             --  the new one at the point of the renaming, to prevent premature
             --  access to unfrozen types. The new declaration reuses the
             --  specification of the previous one, and must not be analyzed.
 
-            pragma Assert (Is_TSS (Rename_Spec, TSS_Stream_Output)
-                           or else Is_TSS (Rename_Spec, TSS_Stream_Input));
-
+            pragma Assert
+              (Is_Primitive (Entity (Nam))
+                 and then
+                   Is_Abstract_Type (Find_Dispatching_Type (Entity (Nam))));
             declare
                Old_Decl : constant Node_Id :=
                             Unit_Declaration_Node (Rename_Spec);
@@ -3777,8 +3781,8 @@ package body Sem_Ch8 is
       E := Homonyms;
       while Present (E) loop
 
-         --  If entity is immediately visible or potentially use
-         --  visible, then process the entity and we are done.
+         --  If entity is immediately visible or potentially use visible, then
+         --  process the entity and we are done.
 
          if Is_Immediately_Visible (E) then
             goto Immediately_Visible_Entity;
@@ -3958,15 +3962,15 @@ package body Sem_Ch8 is
 
       --  Come here with E set to the first immediately visible entity on
       --  the homonym chain. This is the one we want unless there is another
-      --  immediately visible entity further on in the chain for a more
-      --  inner scope (RM 8.3(8)).
+      --  immediately visible entity further on in the chain for an inner
+      --  scope (RM 8.3(8)).
 
       <<Immediately_Visible_Entity>> declare
          Level : Int;
          Scop  : Entity_Id;
 
       begin
-         --  Find scope level of initial entity. When compiling  through
+         --  Find scope level of initial entity. When compiling through
          --  Rtsfind, the previous context is not completely invisible, and
          --  an outer entity may appear on the chain, whose scope is below
          --  the entry for Standard that delimits the current scope stack.
@@ -4243,8 +4247,8 @@ package body Sem_Ch8 is
       P_Name := Entity (Prefix (N));
       O_Name := P_Name;
 
-      --  If the prefix is a renamed package, look for the entity
-      --  in the original package.
+      --  If the prefix is a renamed package, look for the entity in the
+      --  original package.
 
       if Ekind (P_Name) = E_Package
         and then Present (Renamed_Object (P_Name))
@@ -4335,10 +4339,10 @@ package body Sem_Ch8 is
       if No (Id) or else Chars (Id) /= Chars (Selector) then
          Set_Etype (N, Any_Type);
 
-         --  If we are looking for an entity defined in System, try to
-         --  find it in the child package that may have been provided as
-         --  an extension to System. The Extend_System pragma will have
-         --  supplied the name of the extension, which may have to be loaded.
+         --  If we are looking for an entity defined in System, try to find it
+         --  in the child package that may have been provided as an extension
+         --  to System. The Extend_System pragma will have supplied the name of
+         --  the extension, which may have to be loaded.
 
          if Chars (P_Name) = Name_System
            and then Scope (P_Name) = Standard_Standard
@@ -4368,9 +4372,8 @@ package body Sem_Ch8 is
             return;
 
          else
-            --  If the prefix is a single concurrent object, use its
-            --  name in  the error message, rather than that of the
-            --  anonymous type.
+            --  If the prefix is a single concurrent object, use its name in
+            --  the error message, rather than that of the anonymous type.
 
             if Is_Concurrent_Type (P_Name)
               and then Is_Internal_Name (Chars (P_Name))
@@ -4917,7 +4920,6 @@ package body Sem_Ch8 is
       --  in the expansion of record equality).
 
       elsif Present (Entity (Selector_Name (N))) then
-
          if No (Etype (N))
            or else Etype (N) = Any_Type
          then
@@ -6145,6 +6147,16 @@ package body Sem_Ch8 is
             end;
          end if;
 
+      --  Finally, if the current use clause is in the context then
+      --  the clause is redundant when it is nested within the unit.
+
+      elsif Nkind (Parent (Cur_Use)) = N_Compilation_Unit
+        and then Nkind (Parent (Parent (Clause))) /= N_Compilation_Unit
+        and then Get_Source_Unit (Cur_Use) = Get_Source_Unit (Clause)
+      then
+         Redundant := Clause;
+         Prev_Use  := Cur_Use;
+
       else
          null;
       end if;