sem_ch8.adb (Analyze_Use_Type): Code cleanup.

2007-09-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch8.adb (Analyze_Use_Type): Code cleanup.
	(Applicable_Use): Emit a warning when a package tries to use itself.
	(Use_One_Type): Add variable Is_Known_Used. Emit a warning when a type
	is already in use or the package where it is declared is in use or is
	declared in the current package.
	(Spec_Reloaded_For_Body): New subsidiary routine for Use_One_Type.

	* a-tasatt.adb, s-osprim-vxworks.adb, g-socthi-mingw.adb,
	s-intman-vms.adb, g-socket.adb, g-thread.adb, s-tarest.adb,
	s-tassta.adb, s-tporft.adb: Remove redundant 'use type' clause.

From-SVN: r128779

gcc/ada/a-tasatt.adb

@@ -265,8 +265,6 @@ package body Ada.Task_Attributes is
        System.Tasking.Task_Attributes,
        Ada.Exceptions;
 
-   use type System.Tasking.Access_Address;
-
    package POP renames System.Task_Primitives.Operations;
 
    ---------------------------

gcc/ada/g-socket.adb

@@ -48,7 +48,7 @@ with System; use System;
 
 package body GNAT.Sockets is
 
-   use type C.int, System.Address;
+   use type C.int;
 
    Finalized   : Boolean := False;
    Initialized : Boolean := False;
@@ -1404,8 +1404,6 @@ package body GNAT.Sockets is
       Last   : out Ada.Streams.Stream_Element_Offset;
       Flags  : Request_Flag_Type := No_Request_Flag)
    is
-      use type Ada.Streams.Stream_Element_Offset;
-
       Res : C.int;
 
    begin
@@ -1430,8 +1428,6 @@ package body GNAT.Sockets is
       From   : out Sock_Addr_Type;
       Flags  : Request_Flag_Type := No_Request_Flag)
    is
-      use type Ada.Streams.Stream_Element_Offset;
-
       Res : C.int;
       Sin : aliased Sockaddr_In;
       Len : aliased C.int := Sin'Size / 8;
@@ -1604,8 +1600,6 @@ package body GNAT.Sockets is
       Last   : out Ada.Streams.Stream_Element_Offset;
       Flags  : Request_Flag_Type := No_Request_Flag)
    is
-      use type Ada.Streams.Stream_Element_Offset;
-
       Res : C.int;
 
    begin
@@ -1634,8 +1628,6 @@ package body GNAT.Sockets is
       To     : Sock_Addr_Type;
       Flags  : Request_Flag_Type := No_Request_Flag)
    is
-      use type Ada.Streams.Stream_Element_Offset;
-
       Res : C.int;
       Sin : aliased Sockaddr_In;
       Len : constant C.int := Sin'Size / 8;

gcc/ada/g-socthi-mingw.adb

@@ -464,7 +464,6 @@ package body GNAT.Sockets.Thin is
    ----------------
 
    procedure Initialize is
-      use type Interfaces.C.int;
       Return_Value : Interfaces.C.int;
    begin
       if not Initialized then

gcc/ada/g-thread.adb

@@ -128,7 +128,12 @@ package body GNAT.Threads is
       T   : Tasking.Task_Id;
 
       use type Tasking.Task_Id;
+      --  This use clause should be removed once a visibility problem
+      --  with the MaRTE run time has been fixed. ???
+
+      pragma Warnings (Off);
       use type System.OS_Interface.Thread_Id;
+      pragma Warnings (On);
 
    begin
       STPO.Lock_RTS;

gcc/ada/s-intman-vms.adb

@@ -43,7 +43,6 @@ package body System.Interrupt_Management is
 
    procedure Initialize is
       use System.OS_Interface;
-      use type unsigned_long;
       Status : Cond_Value_Type;
 
    begin

gcc/ada/s-osprim-vxworks.adb

@@ -96,9 +96,6 @@ package body System.OS_Primitives is
    function Clock return Duration is
       TS     : aliased timespec;
       Result : int;
-
-      use type Interfaces.C.int;
-
    begin
       Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
       pragma Assert (Result = 0);

gcc/ada/s-tarest.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1999-2006, Free Software Foundation, Inc.          --
+--         Copyright (C) 1999-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -195,7 +195,6 @@ package body System.Tasking.Restricted.Stages is
       --
       --  DO NOT delete ID. As noted, it is needed on some targets.
 
-      use type System.Parameters.Size_Type;
       use type SSE.Storage_Offset;
 
       Secondary_Stack : aliased SSE.Storage_Array

gcc/ada/s-tassta.adb

@@ -943,7 +943,6 @@ package body System.Tasking.Stages is
    --  an at-end handler that the compiler generates.
 
    procedure Task_Wrapper (Self_ID : Task_Id) is
-      use type System.Parameters.Size_Type;
       use type SSE.Storage_Offset;
       use System.Standard_Library;
       use System.Stack_Usage;

gcc/ada/s-tporft.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          Copyright (C) 2002-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -44,8 +44,6 @@ function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is
    Self_Id    : Task_Id;
    Succeeded  : Boolean;
 
-   use type Interfaces.C.unsigned;
-
 begin
    --  This section is tricky. We must not call anything that might require
    --  an ATCB, until the new ATCB is in place. In order to get an ATCB

gcc/ada/sem_ch8.adb

@@ -2180,6 +2180,7 @@ package body Sem_Ch8 is
    ----------------------
 
    procedure Analyze_Use_Type (N : Node_Id) is
+      E  : Entity_Id;
       Id : Entity_Id;
 
    begin
@@ -2194,16 +2195,17 @@ package body Sem_Ch8 is
       Id := First (Subtype_Marks (N));
       while Present (Id) loop
          Find_Type (Id);
+         E := Entity (Id);
 
-         if Entity (Id) /= Any_Type then
+         if E /= Any_Type then
             Use_One_Type (Id);
 
             if Nkind (Parent (N)) = N_Compilation_Unit then
                if Nkind (Id) = N_Identifier then
                   Error_Msg_N ("type is not directly visible", Id);
 
-               elsif Is_Child_Unit (Scope (Entity (Id)))
-                 and then Scope (Entity (Id)) /= System_Aux_Id
+               elsif Is_Child_Unit (Scope (E))
+                 and then Scope (E) /= System_Aux_Id
                then
                   Check_In_Previous_With_Clause (N, Prefix (Id));
                end if;
@@ -2223,6 +2225,13 @@ package body Sem_Ch8 is
 
    begin
       if In_Open_Scopes (Pack) then
+         if Warn_On_Redundant_Constructs
+           and then Pack = Current_Scope
+         then
+            Error_Msg_NE
+              ("& is already use-visible within itself?", Pack_Name, Pack);
+         end if;
+
          return False;
 
       elsif In_Use (Pack) then
@@ -2844,7 +2853,7 @@ package body Sem_Ch8 is
                while Present (Id) loop
 
                   --  Preserve use-visibility of operators that are primitive
-                  --  operators of a type that is use_visible through an active
+                  --  operators of a type that is use-visible through an active
                   --  use_type clause.
 
                   if Nkind (Id) = N_Defining_Operator_Symbol
@@ -5861,9 +5870,9 @@ package body Sem_Ch8 is
 
       if Present (Redundant) then
          Error_Msg_Sloc := Sloc (Prev_Use);
-         Error_Msg_NE (
-           "& is already use_visible through declaration #?",
-              Redundant, Pack_Name);
+         Error_Msg_NE
+           ("& is already use-visible through previous use clause #?",
+            Redundant, Pack_Name);
       end if;
    end Note_Redundant_Use;
 
@@ -6596,9 +6605,38 @@ package body Sem_Ch8 is
    ------------------
 
    procedure Use_One_Type (Id : Node_Id) is
-      T       : Entity_Id;
-      Op_List : Elist_Id;
-      Elmt    : Elmt_Id;
+      Elmt          : Elmt_Id;
+      Is_Known_Used : Boolean;
+      Op_List       : Elist_Id;
+      T             : Entity_Id;
+
+      function Spec_Reloaded_For_Body return Boolean;
+      --  Determine whether the compilation unit is a package body and the use
+      --  type clause is in the spec of the same package. Even though the spec
+      --  was analyzed first, its context is reloaded when analysing the body.
+
+      ----------------------------
+      -- Spec_Reloaded_For_Body --
+      ----------------------------
+
+      function Spec_Reloaded_For_Body return Boolean is
+      begin
+         if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body then
+            declare
+               Spec : constant Node_Id :=
+                        Parent (List_Containing (Parent (Id)));
+            begin
+               return
+                 Nkind (Spec) = N_Package_Specification
+                   and then Corresponding_Body (Parent (Spec)) =
+                              Cunit_Entity (Current_Sem_Unit);
+            end;
+         end if;
+
+         return False;
+      end Spec_Reloaded_For_Body;
+
+   --  Start of processing for Use_One_Type;
 
    begin
       --  It is the type determined by the subtype mark (8.4(8)) whose
@@ -6606,11 +6644,17 @@ package body Sem_Ch8 is
 
       T := Base_Type (Entity (Id));
 
-      Set_Redundant_Use
-        (Id,
-           In_Use (T)
-             or else Is_Potentially_Use_Visible (T)
-             or else In_Use (Scope (T)));
+      --  Either the type itself is used, the package where it is declared
+      --  is in use or the entity is declared in the current package, thus
+      --  use-visible.
+
+      Is_Known_Used :=
+        In_Use (T)
+          or else In_Use (Scope (T))
+          or else Scope (T) = Current_Scope;
+
+      Set_Redundant_Use (Id,
+        Is_Known_Used or else Is_Potentially_Use_Visible (T));
 
       if In_Open_Scopes (Scope (T)) then
          null;
@@ -6640,6 +6684,47 @@ package body Sem_Ch8 is
             Next_Elmt (Elmt);
          end loop;
       end if;
+
+      --  If warning on redundant constructs, check for unnecessary WITH
+
+      if Warn_On_Redundant_Constructs
+        and then Is_Known_Used
+
+         --                     with P;         with P; use P;
+         --    package P is     package X is    package body X is
+         --       type T ...       use P.T;
+
+         --  The compilation unit is the body of X. GNAT first compiles the
+         --  spec of X, then procedes to the body. At that point P is marked
+         --  as use visible. The analysis then reinstalls the spec along with
+         --  its context. The use clause P.T is now recognized as redundant,
+         --  but in the wrong context. Do not emit a warning in such cases.
+
+        and then not Spec_Reloaded_For_Body
+      then
+         --  The type already has a use clause
+
+         if In_Use (T) then
+            Error_Msg_NE
+              ("& is already use-visible through previous use type clause?",
+               Id, Id);
+
+         --  The package where T is declared is already used
+
+         elsif In_Use (Scope (T)) then
+            Error_Msg_Sloc := Sloc (Current_Use_Clause (Scope (T)));
+            Error_Msg_NE
+              ("& is already use-visible through package use clause #?",
+               Id, Id);
+
+         --  The current scope is the package where T is declared
+
+         else
+            Error_Msg_Node_2 := Scope (T);
+            Error_Msg_NE
+              ("& is already use-visible inside package &?", Id, Id);
+         end if;
+      end if;
    end Use_One_Type;
 
    ----------------