diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 56 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 46 | ||||
| -rw-r--r-- | gcc/ada/exp_spark.adb | 72 | ||||
| -rw-r--r-- | gcc/ada/repinfo.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_dim.adb | 50 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 33 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_type.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 137 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 17 |
11 files changed, 341 insertions, 112 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 98850e9..1014e0e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,59 @@ +2017-09-08 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_spark.adb (Expand_SPARK_N_Object_Renaming_Declaration): + Reimplemented. + (Expand_SPARK_Potential_Renaming): Code clean up. + * sem_prag.adb (Analyze_Initialization_Item): Add a guard in case + the item does not have a proper entity. + (Analyze_Input_Item): Add a guard in case the item does not have a + proper entity. + (Collect_States_And_Objects): Include object renamings in the + items being collected. + (Resolve_State): Update the documentation of this routine. + * sem_util.adb (Entity_Of): Add circuitry to handle + renamings of function results. + (Remove_Entity): New routine. + (Remove_Overloaded_Entity): Take advantage of factorization. + * sem_util.ads (Entity_Of): Update the documentation + of this routine. + (Remove_Entity): New routine. + (Remove_Overloaded_Entity): Update the documentation of this + routine. + +2017-09-08 Eric Botcazou <ebotcazou@adacore.com> + + * repinfo.adb (List_Record_Info): During first loop, + do not override the normalized position and first bit + if they have already been set. Move fallback code + for the packed case to the case where it belongs. + * sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): + Also adjust the normalized position of components. + (Adjust_Record_For_Reverse_Bit_Order_Ada_95): Likewise. + +2017-09-08 Ed Schonberg <schonberg@adacore.com> + + * exp_disp.adb (Make_DT, Set_All_DT_Position): Handle properly + the placement of a primitive operation O that renames an operation + R declared in an inner package, and which is thus not a primitive + of the dispatching type of O. In this case O is a new primitive + and does not inherit its dispatch table position from R (which + has none). + +2017-09-08 Ed Schonberg <schonberg@adacore.com> + + * sem_dim.adb (Analyze_Dimension_If_Expression, + Analyze_Dimension_Case_Expression): new subprograms to verify + the dimensional correctness of Ada2012 conditional expressions, + and set properly the dimensions of the construct. + * sem_res.adb (Resolve_If_Expression, Resolve_Case_Expression)): + call Analyze_Dimension. + +2017-09-08 Ed Schonberg <schonberg@adacore.com> + + * sem_type.adb (Expand_Interface_Conversion): Prevent an infinite + loop on an interface declared as a private extension of another + synchronized interface. + 2017-09-08 Ed Schonberg <schonberg@adacore.com> * sem_ch12.adb (Check_Generic_Parent): New procedure within diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 2abd7d1..e5e2c61 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -5896,6 +5896,16 @@ package body Exp_Disp is -- handling of renamings and eliminated primitives. E := Ultimate_Alias (Prim); + + -- If the alias is not a primitive operation then Prim does + -- not rename another primitive, but rather an operation + -- declared elsewhere (e.g. in another scope) and therefore + -- Prim is a new primitive. + + if No (Find_Dispatching_Type (E)) then + E := Prim; + end if; + Prim_Pos := UI_To_Int (DT_Position (E)); -- Skip predefined primitives because they are located in a @@ -7781,24 +7791,36 @@ package body Exp_Disp is Set_DT_Position_Value (Alias (Prim), DT_Position (E)); Set_Fixed_Prim (UI_To_Int (DT_Position (Prim))); - -- Overriding primitives must use the same entry as the - -- overridden primitive. + -- Overriding primitives must use the same entry as the overridden + -- primitive. Note that the Alias of the operation is set when the + -- operation is declared by a renaming, in which case it is not + -- overriding. If it renames another primitive it will use the + -- same dispatch table slot, but if it renames an operation in a + -- nested package it's a new primitive and will have its own slot. elsif not Present (Interface_Alias (Prim)) and then Present (Alias (Prim)) and then Chars (Prim) = Chars (Alias (Prim)) - and then Find_Dispatching_Type (Alias (Prim)) /= Typ - and then Is_Ancestor - (Find_Dispatching_Type (Alias (Prim)), Typ, - Use_Full_View => True) - and then Present (DTC_Entity (Alias (Prim))) + and then Nkind (Unit_Declaration_Node (Prim)) /= + N_Subprogram_Renaming_Declaration then - E := Alias (Prim); - Set_DT_Position_Value (Prim, DT_Position (E)); + declare + Par_Type : constant Entity_Id := + Find_Dispatching_Type (Alias (Prim)); + begin + if Present (Par_Type) + and then Par_Type /= Typ + and then Is_Ancestor (Par_Type, Typ, Use_Full_View => True) + and then Present (DTC_Entity (Alias (Prim))) + then + E := Alias (Prim); + Set_DT_Position_Value (Prim, DT_Position (E)); - if not Is_Predefined_Dispatching_Alias (E) then - Set_Fixed_Prim (UI_To_Int (DT_Position (E))); - end if; + if not Is_Predefined_Dispatching_Alias (E) then + Set_Fixed_Prim (UI_To_Int (DT_Position (E))); + end if; + end if; + end; end if; Next_Elmt (Prim_Elmt); diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index 785652e..211fea3 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -292,10 +292,55 @@ package body Exp_SPARK is ------------------------------------------------ procedure Expand_SPARK_N_Object_Renaming_Declaration (N : Node_Id) is + CFS : constant Boolean := Comes_From_Source (N); + Loc : constant Source_Ptr := Sloc (N); + Obj_Id : constant Entity_Id := Defining_Entity (N); + Nam : constant Node_Id := Name (N); + Typ : constant Entity_Id := Etype (Subtype_Mark (N)); + begin - -- Unconditionally remove all side effects from the name + -- Transform a renaming of the form + + -- Obj_Id : <subtype mark> renames <function call>; + + -- into + + -- Obj_Id : constant <subtype mark> := <function call>; + + -- Invoking Evaluate_Name and ultimately Remove_Side_Effects introduces + -- a temporary to capture the function result. Once potential renamings + -- are rewritten for SPARK, the temporary may be leaked out into source + -- constructs and lead to confusing error diagnostics. Using an object + -- declaration prevents this unwanted side effect. + + if Nkind (Nam) = N_Function_Call then + Rewrite (N, + Make_Object_Declaration (Loc, + Defining_Identifier => Obj_Id, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Typ, Loc), + Expression => Nam)); + + -- Inherit the original Comes_From_Source status of the renaming - Evaluate_Name (Name (N)); + Set_Comes_From_Source (N, CFS); + + -- Sever the link to the renamed function result because the entity + -- will no longer alias anything. + + Set_Renamed_Object (Obj_Id, Empty); + + -- Remove the entity of the renaming declaration from visibility as + -- the analysis of the object declaration will reintroduce it again. + + Remove_Entity (Obj_Id); + Analyze (N); + + -- Otherwise unconditionally remove all side effects from the name + + else + Evaluate_Name (Nam); + end if; end Expand_SPARK_N_Object_Renaming_Declaration; ------------------------ @@ -324,29 +369,30 @@ package body Exp_SPARK is procedure Expand_SPARK_Potential_Renaming (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Ren_Id : constant Entity_Id := Entity (N); + Obj_Id : constant Entity_Id := Entity (N); Typ : constant Entity_Id := Etype (N); - Obj_Id : Node_Id; + Ren : Node_Id; begin -- Replace a reference to a renaming with the actual renamed object - if Ekind (Ren_Id) in Object_Kind then - Obj_Id := Renamed_Object (Ren_Id); + if Ekind (Obj_Id) in Object_Kind then + Ren := Renamed_Object (Obj_Id); - if Present (Obj_Id) then + if Present (Ren) then - -- The renamed object is an entity when instantiating generics - -- or inlining bodies. In this case the renaming is part of the - -- mapping "prologue" which links actuals to formals. + -- Instantiations and inlining of subprograms employ "prologues" + -- which map actual to formal parameters by means of renamings. + -- Replace a reference to a formal by the corresponding actual + -- parameter. - if Nkind (Obj_Id) in N_Entity then - Rewrite (N, New_Occurrence_Of (Obj_Id, Loc)); + if Nkind (Ren) in N_Entity then + Rewrite (N, New_Occurrence_Of (Ren, Loc)); -- Otherwise the renamed object denotes a name else - Rewrite (N, New_Copy_Tree (Obj_Id, New_Sloc => Loc)); + Rewrite (N, New_Copy_Tree (Ren, New_Sloc => Loc)); Reset_Analyzed_Flags (N); end if; diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 57528d6..2634ee8 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -894,30 +894,30 @@ package body Repinfo is Cfbit := Component_Bit_Offset (Comp); if Rep_Not_Constant (Cfbit) then - UI_Image_Length := 2; + -- If the record is not packed, then we know that all fields + -- whose position is not specified have a starting normalized + -- bit position of zero. + if Unknown_Normalized_First_Bit (Comp) + and then not Is_Packed (Ent) + then + Set_Normalized_First_Bit (Comp, Uint_0); + end if; + + UI_Image_Length := 2; -- For "??" marker else -- Complete annotation in case not done - Set_Normalized_Position (Comp, Cfbit / SSU); - Set_Normalized_First_Bit (Comp, Cfbit mod SSU); + if Unknown_Normalized_First_Bit (Comp) then + Set_Normalized_Position (Comp, Cfbit / SSU); + Set_Normalized_First_Bit (Comp, Cfbit mod SSU); + end if; Sunit := Cfbit / SSU; UI_Image (Sunit); end if; - -- If the record is not packed, then we know that all fields - -- whose position is not specified have a starting normalized - -- bit position of zero. - - if Unknown_Normalized_First_Bit (Comp) - and then not Is_Packed (Ent) - then - Set_Normalized_First_Bit (Comp, Uint_0); - end if; - - Max_Suni_Length := - Natural'Max (Max_Suni_Length, UI_Image_Length); + Max_Suni_Length := Natural'Max (Max_Suni_Length, UI_Image_Length); end if; Next_Component_Or_Discriminant (Comp); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 90b629c..9b97f8f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -627,6 +627,7 @@ package body Sem_Ch13 is end if; Set_Component_Bit_Offset (Comp, Pos * SSU + NFB); + Set_Normalized_Position (Comp, Pos + NFB / SSU); Set_Normalized_First_Bit (Comp, NFB mod SSU); end; end loop; @@ -750,6 +751,9 @@ package body Sem_Ch13 is (System_Storage_Unit - 1) - (Start_Bit + CSZ - 1)); + Set_Normalized_Position (Comp, + Component_Bit_Offset (Comp) / System_Storage_Unit); + Set_Normalized_First_Bit (Comp, Component_Bit_Offset (Comp) mod System_Storage_Unit); end if; diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index baa5639..6e829f9 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -194,6 +194,8 @@ package body Sem_Dim is OK_For_Dimension : constant array (Node_Kind) of Boolean := (N_Attribute_Reference => True, + N_Case_Expression => True, + N_If_Expression => True, N_Expanded_Name => True, N_Explicit_Dereference => True, N_Defining_Identifier => True, @@ -254,6 +256,12 @@ package body Sem_Dim is -- N_Type_Conversion -- N_Unchecked_Type_Conversion + procedure Analyze_Dimension_Case_Expression (N : Node_Id); + -- Verify that all alternatives have the same dimension + + procedure Analyze_Dimension_If_Expression (N : Node_Id); + -- Verify that all alternatives have the same dimension + procedure Analyze_Dimension_Number_Declaration (N : Node_Id); -- Procedure to analyze dimension of expression in a number declaration. -- This allows a named number to have nontrivial dimensions, while by @@ -1179,6 +1187,12 @@ package body Sem_Dim is => Analyze_Dimension_Has_Etype (N); + when N_Case_Expression => + Analyze_Dimension_Case_Expression (N); + + when N_If_Expression => + Analyze_Dimension_If_Expression (N); + -- In the presence of a repaired syntax error, an identifier -- may be introduced without a usable type. @@ -1768,6 +1782,27 @@ package body Sem_Dim is end if; end Analyze_Dimension_Call; + --------------------------------------- + -- Analyze_Dimension_Case_Expression -- + --------------------------------------- + + procedure Analyze_Dimension_Case_Expression (N : Node_Id) is + Alt : Node_Id; + Frst : constant Node_Id := First (Alternatives (N)); + Dims : constant Dimension_Type := Dimensions_Of (Expression (Frst)); + begin + Alt := Next (Frst); + while Present (Alt) loop + if Dimensions_Of (Expression (Alt)) /= Dims then + Error_Msg_N ("dimension mismatch in case expression", Alt); + exit; + end if; + + Next (Alt); + end loop; + Copy_Dimensions (Expression (Frst), N); + end Analyze_Dimension_Case_Expression; + --------------------------------------------- -- Analyze_Dimension_Component_Declaration -- --------------------------------------------- @@ -2102,6 +2137,21 @@ package body Sem_Dim is end case; end Analyze_Dimension_Has_Etype; + ------------------------------------- + -- Analyze_Dimension_If_Expression -- + ------------------------------------- + + procedure Analyze_Dimension_If_Expression (N : Node_Id) is + Then_Expr : constant Node_Id := Next (First (Expressions (N))); + Else_Expr : constant Node_Id := Next (Then_Expr); + begin + if Dimensions_Of (Then_Expr) /= Dimensions_Of (Else_Expr) then + Error_Msg_N ("dimensions mismatch in conditional expression", N); + else + Copy_Dimensions (Then_Expr, N); + end if; + end Analyze_Dimension_If_Expression; + ------------------------------------------ -- Analyze_Dimension_Number_Declaration -- ------------------------------------------ diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2f6b230..dc0f830 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -283,9 +283,9 @@ package body Sem_Prag is -- reference for future checks (see Analyze_Refined_State_In_Decls). procedure Resolve_State (N : Node_Id); - -- Handle the overloading of state names by parameterless functions. When N - -- denotes a function, this routine finds the corresponding state and sets - -- the entity of N to that of the state. + -- Handle the overloading of state names by functions. When N denotes a + -- function, this routine finds the corresponding state and sets the entity + -- of N to that of the state. procedure Rewrite_Assertion_Kind (N : Node_Id; @@ -2811,9 +2811,10 @@ package body Sem_Prag is if Is_Entity_Name (Item) then Item_Id := Entity_Of (Item); - if Ekind_In (Item_Id, E_Abstract_State, - E_Constant, - E_Variable) + if Present (Item_Id) + and then Ekind_In (Item_Id, E_Abstract_State, + E_Constant, + E_Variable) then -- The state or variable must be declared in the visible -- declarations of the package (SPARK RM 7.1.5(7)). @@ -2918,14 +2919,15 @@ package body Sem_Prag is if Is_Entity_Name (Input) then Input_Id := Entity_Of (Input); - if Ekind_In (Input_Id, E_Abstract_State, - E_Constant, - E_Generic_In_Out_Parameter, - E_Generic_In_Parameter, - E_In_Parameter, - E_In_Out_Parameter, - E_Out_Parameter, - E_Variable) + if Present (Input_Id) + and then Ekind_In (Input_Id, E_Abstract_State, + E_Constant, + E_Generic_In_Out_Parameter, + E_Generic_In_Parameter, + E_In_Parameter, + E_In_Out_Parameter, + E_Out_Parameter, + E_Variable) then -- The input cannot denote states or objects declared -- within the related package (SPARK RM 7.1.5(4)). @@ -3073,7 +3075,8 @@ package body Sem_Prag is Decl := First (Visible_Declarations (Pack_Spec)); while Present (Decl) loop if Comes_From_Source (Decl) - and then Nkind (Decl) = N_Object_Declaration + and then Nkind_In (Decl, N_Object_Declaration, + N_Object_Renaming_Declaration) then Append_New_Elmt (Defining_Entity (Decl), States_And_Objs); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 2d8751c..ed96c53 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6772,6 +6772,7 @@ package body Sem_Res is Set_Etype (N, Typ); Eval_Case_Expression (N); + Analyze_Dimension (N); end Resolve_Case_Expression; ------------------------------- @@ -8357,6 +8358,8 @@ package body Sem_Res is if not Error_Posted (N) then Eval_If_Expression (N); end if; + + Analyze_Dimension (N); end Resolve_If_Expression; ------------------------------- diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index f098760..c9d8f4b 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2947,11 +2947,14 @@ package body Sem_Type is -- Continue climbing else - -- Use the full-view of private types (if allowed) + -- Use the full-view of private types (if allowed). + -- Guard against infinite loops when full view has same + -- type as parent, as can happen with interface extensions, if Use_Full_View and then Is_Private_Type (Par) and then Present (Full_View (Par)) + and then Par /= Etype (Full_View (Par)) then Par := Etype (Full_View (Par)); else diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e9bcdad..968de98 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -7117,23 +7117,46 @@ package body Sem_Util is --------------- function Entity_Of (N : Node_Id) return Entity_Id is - Id : Entity_Id; + Id : Entity_Id; + Ren : Node_Id; begin + -- Assume that the arbitrary node does not have an entity + Id := Empty; if Is_Entity_Name (N) then Id := Entity (N); - -- Follow a possible chain of renamings to reach the root renamed - -- object. + -- Follow a possible chain of renamings to reach the earliest renamed + -- source object. while Present (Id) and then Is_Object (Id) and then Present (Renamed_Object (Id)) loop - if Is_Entity_Name (Renamed_Object (Id)) then - Id := Entity (Renamed_Object (Id)); + Ren := Renamed_Object (Id); + + -- The reference renames an abstract state or a whole object + + -- Obj : ...; + -- Ren : ... renames Obj; + + if Is_Entity_Name (Ren) then + Id := Entity (Ren); + + -- The reference renames a function result. Check the original + -- node in case expansion relocates the function call. + + -- Ren : ... renames Func_Call; + + elsif Nkind (Original_Node (Ren)) = N_Function_Call then + exit; + + -- Otherwise the reference renames something which does not yield + -- an abstract state or a whole object. Treat the reference as not + -- having a proper entity for SPARK legality purposes. + else Id := Empty; exit; @@ -20369,6 +20392,61 @@ package body Sem_Util is end if; end References_Generic_Formal_Type; + ------------------- + -- Remove_Entity -- + ------------------- + + procedure Remove_Entity (Id : Entity_Id) is + Scop : constant Entity_Id := Scope (Id); + Prev_Id : Entity_Id; + + begin + -- Remove the entity from the homonym chain. When the entity is the + -- head of the chain, associate the entry in the name table with its + -- homonym effectively making it the new head of the chain. + + if Current_Entity (Id) = Id then + Set_Name_Entity_Id (Chars (Id), Homonym (Id)); + + -- Otherwise link the previous and next homonyms + + else + Prev_Id := Current_Entity (Id); + while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop + Prev_Id := Homonym (Prev_Id); + end loop; + + Set_Homonym (Prev_Id, Homonym (Id)); + end if; + + -- Remove the entity from the scope entity chain. When the entity is + -- the head of the chain, set the next entity as the new head of the + -- chain. + + if First_Entity (Scop) = Id then + Prev_Id := Empty; + Set_First_Entity (Scop, Next_Entity (Id)); + + -- Otherwise the entity is either in the middle of the chain or it acts + -- as its tail. Traverse and link the previous and next entities. + + else + Prev_Id := First_Entity (Scop); + while Present (Prev_Id) and then Next_Entity (Prev_Id) /= Id loop + Next_Entity (Prev_Id); + end loop; + + Set_Next_Entity (Prev_Id, Next_Entity (Id)); + end if; + + -- Handle the case where the entity acts as the tail of the scope entity + -- chain. + + if Last_Entity (Scop) = Id then + Set_Last_Entity (Scop, Prev_Id); + end if; + end Remove_Entity; + -------------------- -- Remove_Homonym -- -------------------- @@ -20428,57 +20506,14 @@ package body Sem_Util is -- Local variables - Scop : constant Entity_Id := Scope (Id); - Formal : Entity_Id; - Prev_Id : Entity_Id; + Formal : Entity_Id; -- Start of processing for Remove_Overloaded_Entity begin - -- Remove the entity from the homonym chain. When the entity is the - -- head of the chain, associate the entry in the name table with its - -- homonym effectively making it the new head of the chain. - - if Current_Entity (Id) = Id then - Set_Name_Entity_Id (Chars (Id), Homonym (Id)); - - -- Otherwise link the previous and next homonyms - - else - Prev_Id := Current_Entity (Id); - while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop - Prev_Id := Homonym (Prev_Id); - end loop; - - Set_Homonym (Prev_Id, Homonym (Id)); - end if; - - -- Remove the entity from the scope entity chain. When the entity is - -- the head of the chain, set the next entity as the new head of the - -- chain. - - if First_Entity (Scop) = Id then - Prev_Id := Empty; - Set_First_Entity (Scop, Next_Entity (Id)); + -- Remove the entity from both the homonym and scope chains - -- Otherwise the entity is either in the middle of the chain or it acts - -- as its tail. Traverse and link the previous and next entities. - - else - Prev_Id := First_Entity (Scop); - while Present (Prev_Id) and then Next_Entity (Prev_Id) /= Id loop - Next_Entity (Prev_Id); - end loop; - - Set_Next_Entity (Prev_Id, Next_Entity (Id)); - end if; - - -- Handle the case where the entity acts as the tail of the scope entity - -- chain. - - if Last_Entity (Scop) = Id then - Set_Last_Entity (Scop, Prev_Id); - end if; + Remove_Entity (Id); -- The entity denotes a primitive subprogram. Remove it from the list of -- primitives of the associated controlling type. diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b8f4bed..58a362b 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -689,8 +689,9 @@ package Sem_Util is -- are entered using Sem_Ch6.Enter_Overloadable_Entity. function Entity_Of (N : Node_Id) return Entity_Id; - -- Return the entity of N or Empty. If N is a renaming, return the entity - -- of the root renamed object. + -- Obtain the entity of arbitrary node N. If N is a renaming, return the + -- entity of the earliest renamed source abstract state or whole object. + -- If no suitable entity is available, return Empty. procedure Explain_Limited_Type (T : Entity_Id; N : Node_Id); -- This procedure is called after issuing a message complaining about an @@ -2265,14 +2266,20 @@ package Sem_Util is -- Returns True if the expression Expr contains any references to a generic -- type. This can only happen within a generic template. + procedure Remove_Entity (Id : Entity_Id); + -- Remove arbitrary entity Id from both the homonym and scope chains. Use + -- Remove_Overloaded_Entity for overloadable entities. Note: the removal + -- performed by this routine does not affect the visibility of existing + -- homonyms. + procedure Remove_Homonym (E : Entity_Id); -- Removes E from the homonym chain procedure Remove_Overloaded_Entity (Id : Entity_Id); -- Remove arbitrary entity Id from the homonym chain, the scope chain and - -- the primitive operations list of the associated controlling type. NOTE: - -- the removal performed by this routine does not affect the visibility of - -- existing homonyms. + -- the primitive operations list of the associated controlling type. Use + -- Remove_Entity for non-overloadable entities. Note: the removal performed + -- by this routine does not affect the visibility of existing homonyms. function Remove_Suffix (E : Entity_Id; Suffix : Character) return Name_Id; -- Returns the name of E without Suffix |