mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 09:40:36 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_ch8.adb (Analyze_Use_Type): Code cleanup.

Browse Source 
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
This commit is contained in:
Hristian Kirtchev 2007-09-26 12:41:24 +02:00 committed by Arnaud Charlet
parent ba6dccf8f9
commit 954c111a1a
10 changed files with 108 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/a-tasatt.adb
View File

@ -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;
---------------------------

10
gcc/ada/g-socket.adb
View File

@ -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;

1
gcc/ada/g-socthi-mingw.adb
View File

@ -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

5
gcc/ada/g-thread.adb
View File

@ -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;

1
gcc/ada/s-intman-vms.adb
View File

@ -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

3
gcc/ada/s-osprim-vxworks.adb
View File

@ -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);

3
gcc/ada/s-tarest.adb
View File

@ -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

1
gcc/ada/s-tassta.adb
View File

@ -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;

4
gcc/ada/s-tporft.adb
View File

@ -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

115
gcc/ada/sem_ch8.adb
View File

@ -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;
----------------