From 11560bcc3526da0ab979df1349f3339068e5345a Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Tue, 14 Aug 2007 10:46:54 +0200 Subject: [PATCH] sem_ch8.ads, [...] (Find_Type, [...]): Use correct entity as denoted entity for the selector of the rewritten node. 2007-08-14 Thomas Quinot Ed Schonberg * 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 --- gcc/ada/sem_ch8.adb | 206 +++++++++++++++++++++++++++++--------------- gcc/ada/sem_ch8.ads | 36 ++++---- 2 files changed, 152 insertions(+), 90 deletions(-) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 7de0b707c54..46349f43c18 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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,6 +1703,31 @@ package body Sem_Ch8 is return; 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. + + -- This is a bit of a kludge, which introduces a really irregular use of + -- Ada_Version[_Explicit]. Would be nice to find cleaner way to do this + -- ??? + + Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95); + Ada_Version_Explicit := Ada_Version; + + 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. @@ -1712,30 +1737,21 @@ package body Sem_Ch8 is 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. + -- between a subprogram and its correct renaming. - if Ada_Version >= Ada_05 then + -- 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; - -- 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. - - -- This is a bit of a kludge, which introduces a really irregular use of - -- Ada_Version[_Explicit]. Would be nice to find cleaner way to do this - -- ??? - - Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95); - Ada_Version_Explicit := Ada_Version; - - if No (Old_S) then - Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual); - end if; - if Old_S /= Any_Id then if Is_Actual and then From_Default (N) @@ -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 diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads index 6e3f834438b..0a276561b05 100644 --- a/gcc/ada/sem_ch8.ads +++ b/gcc/ada/sem_ch8.ads @@ -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 -- 2.30.2