mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-22 15:00:55 +08:00
Code Issues Packages Projects Releases Wiki Activity

sem_ch8.ads, [...] (Find_Type, [...]): Use correct entity as denoted entity for the selector of the rewritten node.

Browse Source 
2007-08-14  Thomas Quinot  <quinot@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.ads, sem_ch8.adb (Find_Type, case of a 'Base attribute
	reference): Use correct entity as denoted entity for the selector of
	the rewritten node.
	(Find_Direct_Name): Add comment about Generate_Reference incorrectly
	setting the Referenced_As_LHS flag for entities that are implicitly
	dereferenced.
	(Find_Type): If the type is an internally generated incomplete type,
	mark the full view as referenced, to prevent spurious warnings.
	(Find_Selected_Component, Has_Components): Handle properly non-limited
	views that are themselves incomplete types.
	Handle interfaces visible through limited-with clauses.
	(Analyze_Subprogram_Renaming): Disambiguate and set the entity of a
	subprogram generic actual for which we have generated a renaming.
	Warn when the renaming introduces a homonym of
	the renamed entity, and the renamed entity is directly visible.

From-SVN: r127446
This commit is contained in:
Thomas Quinot 2007-08-14 10:46:54 +02:00 committed by Arnaud Charlet
parent fe685905a1
commit 11560bcc35
2 changed files with 153 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

208
gcc/ada/sem_ch8.adb
View File

@ -721,7 +721,7 @@ package body Sem_Ch8 is
Set_Etype (Nam, T);
end if;
-- Complete analysis of the subtype mark in any case, for ASIS use.
-- Complete analysis of the subtype mark in any case, for ASIS use
if Present (Subtype_Mark (N)) then
Find_Type (Subtype_Mark (N));
@ -759,7 +759,7 @@ package body Sem_Ch8 is
and then not Is_Access_Constant (Etype (Nam))
then
Error_Msg_N ("(Ada 2005): the renamed object is not "
& "access-to-constant ('R'M 8.5.1(6))", N);
& "access-to-constant (RM 8.5.1(6))", N);
end if;
end if;
@ -872,7 +872,7 @@ package body Sem_Ch8 is
Error_Node);
Error_Msg_Sloc := Sloc (N);
Error_Msg_N
("\because of renaming at# ('R'M 8.5.4(4))", Error_Node);
("\because of renaming # (RM 8.5.4(4))", Error_Node);
-- Ada 2005 (AI-423): Otherwise, the subtype of the object name
-- shall exclude null.
@ -881,7 +881,7 @@ package body Sem_Ch8 is
and then not Has_Null_Exclusion (Subtyp_Decl)
then
Error_Msg_N
("`NOT NULL` required for subtype & ('R'M 8.5.1(4.6/2))",
("`NOT NULL` required for subtype & (RM 8.5.1(4.6/2))",
Defining_Identifier (Subtyp_Decl));
end if;
end if;
@ -1544,7 +1544,7 @@ package body Sem_Ch8 is
Error_Msg_Sloc := Sloc (Hidden);
Error_Msg_N ("?default subprogram is resolved " &
"in the generic declaration " &
"('R'M 12.6(17))", N);
"(RM 12.6(17))", N);
Error_Msg_NE ("\?and will not use & #", N, Hidden);
end if;
end;
@ -1703,24 +1703,6 @@ package body Sem_Ch8 is
return;
end if;
-- Most common case: subprogram renames subprogram. No body is generated
-- in this case, so we must indicate the declaration is complete as is.
if No (Rename_Spec) then
Set_Has_Completion (New_S);
Set_Is_Pure (New_S, Is_Pure (Entity (Nam)));
Set_Is_Preelaborated (New_S, Is_Preelaborated (Entity (Nam)));
-- Ada 2005 (AI-423): Check the consistency of null exclusions
-- between a subprogram and its renaming.
if Ada_Version >= Ada_05 then
Check_Null_Exclusion
(Ren => New_S,
Sub => Entity (Nam));
end if;
end if;
-- Find the renamed entity that matches the given specification. Disable
-- Ada_83 because there is no requirement of full conformance between
-- renamed entity and new entity, even though the same circuit is used.
@ -1734,6 +1716,40 @@ package body Sem_Ch8 is
if No (Old_S) then
Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual);
-- When the renamed subprogram is overloaded and used as an actual
-- of a generic, its entity is set to the first available homonym.
-- We must first disambiguate the name, then set the proper entity.
if Is_Actual
and then Is_Overloaded (Nam)
then
Set_Entity (Nam, Old_S);
end if;
end if;
-- Most common case: subprogram renames subprogram. No body is generated
-- in this case, so we must indicate the declaration is complete as is.
if No (Rename_Spec) then
Set_Has_Completion (New_S);
Set_Is_Pure (New_S, Is_Pure (Entity (Nam)));
Set_Is_Preelaborated (New_S, Is_Preelaborated (Entity (Nam)));
-- Ada 2005 (AI-423): Check the consistency of null exclusions
-- between a subprogram and its correct renaming.
-- Note: the Any_Id check is a guard that prevents compiler crashes
-- when performing a null exclusion check between a renaming and a
-- renamed subprogram that has been found to be illegal.
if Ada_Version >= Ada_05
and then Entity (Nam) /= Any_Id
then
Check_Null_Exclusion
(Ren => New_S,
Sub => Entity (Nam));
end if;
end if;
if Old_S /= Any_Id then
@ -2035,6 +2051,25 @@ package body Sem_Ch8 is
New_S, Old_S);
end if;
-- Another warning or some utility: if the new subprogram as the same
-- name as the old one, the old one is not hidden by an outer homograph,
-- the new one is not a public symbol, and the old one is otherwise
-- directly visible, the renaming is superfluous.
if Chars (Old_S) = Chars (New_S)
and then Comes_From_Source (N)
and then Scope (Old_S) /= Standard_Standard
and then Warn_On_Redundant_Constructs
and then
(Is_Immediately_Visible (Old_S)
or else Is_Potentially_Use_Visible (Old_S))
and then Is_Overloadable (Current_Scope)
and then Chars (Current_Scope) /= Chars (Old_S)
then
Error_Msg_N
("?redundant renaming, entity is directly visible", Name (N));
end if;
Ada_Version := Save_AV;
Ada_Version_Explicit := Save_AV_Exp;
end Analyze_Subprogram_Renaming;
@ -2372,7 +2407,7 @@ package body Sem_Ch8 is
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Return_Statement (Loc,
Make_Simple_Return_Statement (Loc,
Expression => Attr_Node))));
-- Case of renaming a procedure
@ -3421,11 +3456,11 @@ package body Sem_Ch8 is
-- undefined reference.
if not All_Errors_Mode then
Urefs.Increment_Last;
Urefs.Table (Urefs.Last).Node := N;
Urefs.Table (Urefs.Last).Err := Emsg;
Urefs.Table (Urefs.Last).Nvis := Nvis;
Urefs.Table (Urefs.Last).Loc := Sloc (N);
Urefs.Append (
(Node => N,
Err => Emsg,
Nvis => Nvis,
Loc => Sloc (N)));
end if;
Msg := True;
@ -3804,7 +3839,7 @@ package body Sem_Ch8 is
-- to the discriminant in the initialization procedure.
else
-- Entity is unambiguous, indicate that it is referenced here One
-- Entity is unambiguous, indicate that it is referenced here. One
-- slightly odd case is that we do not want to set the Referenced
-- flag if the entity is a label, and the identifier is the label
-- in the source, since this is not a reference from the point of
@ -3819,7 +3854,14 @@ package body Sem_Ch8 is
Set_Referenced (E, R);
end;
-- Normal case, not a label. Generate reference
-- Normal case, not a label: generate reference
-- ??? It is too early to generate a reference here even if
-- the entity is unambiguous, because the tree is not
-- sufficiently typed at this point for Generate_Reference to
-- determine whether this reference modifies the denoted object
-- (because implicit derefences cannot be identified prior to
-- full type resolution).
else
Generate_Reference (E, N);
@ -3938,6 +3980,8 @@ package body Sem_Ch8 is
-- the scope, it is important to note that the limited view also
-- has shadow entities associated nested packages. For this reason
-- the correct scope of the entity is the scope of the real entity
-- The non-limited view may itself be incomplete, in which case
-- get the full view if available.
elsif From_With_Type (Id)
and then Is_Type (Id)
@ -3945,7 +3989,7 @@ package body Sem_Ch8 is
and then Present (Non_Limited_View (Id))
and then Scope (Non_Limited_View (Id)) = P_Name
then
Candidate := Non_Limited_View (Id);
Candidate := Get_Full_View (Non_Limited_View (Id));
Is_New_Candidate := True;
else
@ -4706,6 +4750,8 @@ package body Sem_Ch8 is
then
-- Selected component of record. Type checking will validate
-- name of selector.
-- ??? could we rewrite an implicit dereference into an explicit
-- one here?
Analyze_Selected_Component (N);
@ -4865,7 +4911,7 @@ package body Sem_Ch8 is
then
Error_Msg_N
("\dereference must not be of an incomplete type " &
"('R'M 3.10.1)", P);
"(RM 3.10.1)", P);
end if;
else
@ -4899,10 +4945,9 @@ package body Sem_Ch8 is
elsif Nkind (N) = N_Attribute_Reference then
-- Class attribute. This is only valid in Ada 95 mode, but we don't
-- do a check, since the tagged type referenced could only exist if
-- we were in 95 mode when it was declared (or, if we were in Ada
-- 83 mode, then an error message would already have been issued).
-- Class attribute. This is not valid in Ada 83 mode, but we do not
-- need to enforce that at this point, since the declaration of the
-- tagged type in the prefix would have been flagged already.
if Attribute_Name (N) = Name_Class then
Check_Restriction (No_Dispatch, N);
@ -4918,8 +4963,8 @@ package body Sem_Ch8 is
T := Base_Type (Entity (Prefix (N)));
-- Case type is not known to be tagged. Its appearance in the
-- prefix of the 'Class attribute indicates that the full view
-- Case where type is not known to be tagged. Its appearance in
-- the prefix of the 'Class attribute indicates that the full view
-- will be tagged.
if not Is_Tagged_Type (T) then
@ -4927,6 +4972,24 @@ package body Sem_Ch8 is
-- It is legal to denote the class type of an incomplete
-- type. The full type will have to be tagged, of course.
-- In Ada2005 this usage is declared obsolescent, so we
-- warn accordingly.
-- ??? This test is temporarily disabled (always False)
-- because it causes an unwanted warning on GNAT sources
-- (built with -gnatg, which includes Warn_On_Obsolescent_
-- Feature). Once this issue is cleared in the sources, it
-- can be enabled.
if not Is_Tagged_Type (T)
and then Ada_Version >= Ada_05
and then Warn_On_Obsolescent_Feature
and then False
then
Error_Msg_N
("applying 'Class to an untagged imcomplete type"
& " is an obsolescent feature (RM J.11)", N);
end if;
Set_Is_Tagged_Type (T);
Set_Primitive_Operations (T, New_Elmt_List);
@ -5026,14 +5089,12 @@ package body Sem_Ch8 is
if Nkind (Prefix (N)) = N_Expanded_Name then
Rewrite (N,
Make_Expanded_Name (Sloc (N),
Chars => Chars (Entity (N)),
Prefix => New_Copy (Prefix (Prefix (N))),
Selector_Name =>
New_Reference_To (Entity (N), Sloc (N))));
Chars => Chars (T),
Prefix => New_Copy (Prefix (Prefix (N))),
Selector_Name => New_Reference_To (T, Sloc (N))));
else
Rewrite (N,
New_Reference_To (Entity (N), Sloc (N)));
Rewrite (N, New_Reference_To (T, Sloc (N)));
end if;
Set_Entity (N, T);
@ -5078,8 +5139,32 @@ package body Sem_Ch8 is
Set_Entity (N, Any_Type);
else
-- If the type is an incomplete type created to handle
-- anonymous access components of a record type, then the
-- incomplete type is the visible entity and subsequent
-- references will point to it. Mark the original full
-- type as referenced, to prevent spurious warnings.
if Is_Incomplete_Type (T_Name)
and then Present (Full_View (T_Name))
and then not Comes_From_Source (T_Name)
then
Set_Referenced (Full_View (T_Name));
end if;
T_Name := Get_Full_View (T_Name);
-- Ada 2005 (AI-251, AI-50217): Handle interfaces visible through
-- limited-with clauses
if From_With_Type (T_Name)
and then Ekind (T_Name) in Incomplete_Kind
and then Present (Non_Limited_View (T_Name))
and then Is_Interface (Non_Limited_View (T_Name))
then
T_Name := Non_Limited_View (T_Name);
end if;
if In_Open_Scopes (T_Name) then
if Ekind (Base_Type (T_Name)) = E_Task_Type then
@ -5141,28 +5226,6 @@ package body Sem_Ch8 is
end if;
end Find_Type;
-------------------
-- Get_Full_View --
-------------------
function Get_Full_View (T_Name : Entity_Id) return Entity_Id is
begin
if Ekind (T_Name) = E_Incomplete_Type
and then Present (Full_View (T_Name))
then
return Full_View (T_Name);
elsif Is_Class_Wide_Type (T_Name)
and then Ekind (Root_Type (T_Name)) = E_Incomplete_Type
and then Present (Full_View (Root_Type (T_Name)))
then
return Class_Wide_Type (Full_View (Root_Type (T_Name)));
else
return T_Name;
end if;
end Get_Full_View;
------------------------------------
-- Has_Implicit_Character_Literal --
------------------------------------
@ -5608,7 +5671,8 @@ package body Sem_Ch8 is
or else (Is_Incomplete_Type (T1)
and then From_With_Type (T1)
and then Present (Non_Limited_View (T1))
and then Is_Record_Type (Non_Limited_View (T1)));
and then Is_Record_Type
(Get_Full_View (Non_Limited_View (T1))));
end Has_Components;
-- Start of processing for Is_Appropriate_For_Record
@ -5817,7 +5881,7 @@ package body Sem_Ch8 is
end if;
Scope_Suppress := SST.Save_Scope_Suppress;
Local_Entity_Suppress.Set_Last (SST.Save_Local_Entity_Suppress);
Local_Suppress_Stack_Top := SST.Save_Local_Suppress_Stack_Top;
if Debug_Flag_W then
Write_Str ("--> exiting scope: ");
@ -5886,9 +5950,9 @@ package body Sem_Ch8 is
SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
begin
SST.Entity := S;
SST.Save_Scope_Suppress := Scope_Suppress;
SST.Save_Local_Entity_Suppress := Local_Entity_Suppress.Last;
SST.Entity := S;
SST.Save_Scope_Suppress := Scope_Suppress;
SST.Save_Local_Suppress_Stack_Top := Local_Suppress_Stack_Top;
if Scope_Stack.Last > Scope_Stack.First then
SST.Component_Alignment_Default := Scope_Stack.Table

36
gcc/ada/sem_ch8.ads
View File

@ -76,15 +76,15 @@ package Sem_Ch8 is
-- appearing in context clauses.
procedure Find_Direct_Name (N : Node_Id);
-- Given a direct name (Identifier or Operator_Symbol), this routine
-- scans the homonym chain for the name searching for corresponding
-- visible entities to find the referenced entity (or in the case of
-- overloading), entities. On return, the Entity, and Etype fields
-- are set. In the non-overloaded case, these are the correct final
-- entries. In the overloaded case, Is_Overloaded is set, Etype and
-- Entity refer to an arbitrary element of the overloads set, and
-- an appropriate list of entries has been made in the overload
-- interpretation table (to be disambiguated in the resolve phase).
-- Given a direct name (Identifier or Operator_Symbol), this routine scans
-- the homonym chain for the name searching for corresponding visible
-- entities to find the referenced entity (or in the case of overloading),
-- entities. On return, the Entity and Etype fields are set. In the
-- non-overloaded case, these are the correct final entries. In the
-- overloaded case, Is_Overloaded is set, Etype and Entity refer to an
-- arbitrary element of the overloads set, and an appropriate list of
-- entries has been made in the overload interpretation table (to be
-- disambiguated in the resolve phase).
procedure Find_Selected_Component (N : Node_Id);
-- Resolve various cases of selected components, recognize expanded names
@ -93,16 +93,14 @@ package Sem_Ch8 is
-- Perform name resolution, and verify that the name found is that of a
-- type. On return the Entity and Etype fields of the node N are set
-- appropriately. If it is an incomplete type whose full declaration has
-- been seen, they are set to the entity in the full declaration.
-- Similarly, if the type is private, it has received a full declaration,
-- and we are in the private part or body of the package, then the two
-- fields are set to the entity of the full declaration as well. This
-- procedure also provides special processing for Class types as well.
function Get_Full_View (T_Name : Entity_Id) return Entity_Id;
-- If T_Name is an incomplete type and the full declaration has been
-- seen, or is the name of a class_wide type whose root is incomplete.
-- return the corresponding full declaration.
-- been seen, they are set to the entity in the full declaration. If it
-- is an incomplete type associated with an interface visible through a
-- limited-with clause, whose full declaration has been seen, they are
-- set to the entity in the full declaration. Similarly, if the type is
-- private, it has received a full declaration, and we are in the private
-- part or body of the package, then the two fields are set to the entity
-- of the full declaration as well. This procedure also has special
-- processing for 'Class attribute references.
procedure Initialize;
-- Initializes data structures used for visibility analysis. Must be