aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEd Schonberg <schonberg@adacore.com>2008-05-20 14:50:43 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2008-05-20 14:50:43 +0200
commitff81221b5bd3b8101301e4eaaa15bde8b0553b00 (patch)
tree13ae7d313472367fc59edd8115f54a80a6fd170e
parent5ff22245698ae9b3f229ab127744baceddbf6a02 (diff)
downloadgcc-ff81221b5bd3b8101301e4eaaa15bde8b0553b00.zip
gcc-ff81221b5bd3b8101301e4eaaa15bde8b0553b00.tar.gz
gcc-ff81221b5bd3b8101301e4eaaa15bde8b0553b00.tar.bz2
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. From-SVN: r135641
-rw-r--r--gcc/ada/sem_ch8.adb58
1 files changed, 35 insertions, 23 deletions
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 3b28bdf..6ebb647 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -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;