diff options
Diffstat (limited to 'gcc/ada/sem_util.adb')
| -rw-r--r-- | gcc/ada/sem_util.adb | 551 |
1 files changed, 416 insertions, 135 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0e1505b..74de26a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -52,6 +52,7 @@ with Sem_Attr; use Sem_Attr; with Sem_Cat; use Sem_Cat; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; @@ -333,7 +334,7 @@ package body Sem_Util is -- Add_Global_Declaration -- ---------------------------- - procedure Add_Global_Declaration (N : Node_Id) is + procedure Add_Global_Declaration (Decl : Node_Id) is Aux_Node : constant Node_Id := Aux_Decls_Node (Cunit (Current_Sem_Unit)); begin @@ -341,8 +342,8 @@ package body Sem_Util is Set_Declarations (Aux_Node, New_List); end if; - Append_To (Declarations (Aux_Node), N); - Analyze (N); + Append_To (Declarations (Aux_Node), Decl); + Analyze (Decl); end Add_Global_Declaration; -------------------------------- @@ -2176,6 +2177,7 @@ package body Sem_Util is Def_Id : Entity_Id; Btyp : Entity_Id := Base_Type (Typ); + Predicated_Parent_Used : Boolean := False; begin -- The Related_Node better be here or else we won't be able to -- attach new itypes to a node in the tree. @@ -2190,6 +2192,25 @@ package body Sem_Util is and then Present (Underlying_Type (Btyp)) then Btyp := Underlying_Type (Btyp); + + -- If a predicate has been specified for an unconstrained + -- ancestor subtype, then that ancestor subtype needs to also + -- be an ancestor subtype for the subtype we are building so that + -- we don't lose the predicate. It is somewhat ugly here to have + -- to replicate the precondition for Predicated_Parent. + + elsif Typ in E_Array_Subtype_Id + | E_Record_Subtype_Id + | E_Record_Subtype_With_Private_Id + and then Present (Predicated_Parent (Typ)) + then + -- Assert that the following assignment is only changing the + -- subtype, not the type. + + pragma Assert (Base_Type (Predicated_Parent (Typ)) = Btyp); + + Btyp := Predicated_Parent (Typ); + Predicated_Parent_Used := True; end if; Indic := @@ -2211,7 +2232,10 @@ package body Sem_Util is Analyze (Subtyp_Decl, Suppress => All_Checks); - if Is_Itype (Def_Id) and then Has_Predicates (Typ) then + if Is_Itype (Def_Id) + and then Has_Predicates (Typ) + and then not Predicated_Parent_Used + then Inherit_Predicate_Flags (Def_Id, Typ); -- Indicate where the predicate function may be found @@ -2686,6 +2710,15 @@ package body Sem_Util is Append_Unique_Elmt (N, Identifiers_List); end if; + + -- Skip attribute references created by the compiler, typically + -- 'Constrained applied to one of the writable actuals, to avoid + -- spurious errors. + + elsif Nkind (N) = N_Attribute_Reference + and then not Comes_From_Source (N) + then + return Skip; end if; return OK; @@ -3025,7 +3058,7 @@ package body Sem_Util is -- For an array aggregate, a discrete_choice_list that has -- a nonstatic range is considered as two or more separate - -- occurrences of the expression (RM 6.4.1(20/3)). + -- occurrences of the expression (RM 6.4.1(6.20/3)). elsif Is_Array_Type (Etype (N)) and then Nkind (N) = N_Aggregate @@ -3110,48 +3143,105 @@ package body Sem_Util is end loop; end if; - -- Handle discrete associations + -- Handle named associations if Present (Component_Associations (N)) then Assoc := First (Component_Associations (N)); while Present (Assoc) loop - if not Box_Present (Assoc) then - Choice := First (Choices (Assoc)); - while Present (Choice) loop + Handle_Association : declare - -- For now we skip discriminants since it requires - -- performing the analysis in two phases: first one - -- analyzing discriminants and second one analyzing - -- the rest of components since discriminants are - -- evaluated prior to components: too much extra - -- work to detect a corner case??? + procedure Collect_Expression_Ids (Expr : Node_Id); + -- Collect identifiers in association expression Expr - if Nkind (Choice) in N_Has_Entity - and then Present (Entity (Choice)) - and then Ekind (Entity (Choice)) = E_Discriminant - then - null; + procedure Handle_Association_Choices + (Choices : List_Id; Expr : Node_Id); + -- Collect identifiers in an association expression + -- Expr for each choice in Choices. + + ---------------------------- + -- Collect_Expression_Ids -- + ---------------------------- - elsif Box_Present (Assoc) then - null; + procedure Collect_Expression_Ids (Expr : Node_Id) is + Comp_Expr : Node_Id; + begin + if not Analyzed (Expr) then + Comp_Expr := New_Copy_Tree (Expr); + Set_Parent (Comp_Expr, Parent (N)); + Preanalyze_Without_Errors (Comp_Expr); else - if not Analyzed (Expression (Assoc)) then - Comp_Expr := - New_Copy_Tree (Expression (Assoc)); - Set_Parent (Comp_Expr, Parent (N)); - Preanalyze_Without_Errors (Comp_Expr); + Comp_Expr := Expr; + end if; + + Collect_Identifiers (Comp_Expr); + end Collect_Expression_Ids; + + -------------------------------- + -- Handle_Association_Choices -- + -------------------------------- + + procedure Handle_Association_Choices + (Choices : List_Id; Expr : Node_Id) + is + Choice : Node_Id := First (Choices); + + begin + while Present (Choice) loop + + -- For now skip discriminants since it requires + -- performing analysis in two phases: first one + -- analyzing discriminants and second analyzing + -- the rest of components since discriminants + -- are evaluated prior to components: too much + -- extra work to detect a corner case??? + + if Nkind (Choice) in N_Has_Entity + and then Present (Entity (Choice)) + and then + Ekind (Entity (Choice)) = E_Discriminant + then + null; + else - Comp_Expr := Expression (Assoc); + Collect_Expression_Ids (Expr); end if; - Collect_Identifiers (Comp_Expr); - end if; + Next (Choice); + end loop; + end Handle_Association_Choices; - Next (Choice); - end loop; - end if; + begin + if not Box_Present (Assoc) then + if Nkind (Assoc) = N_Component_Association then + Handle_Association_Choices + (Choices (Assoc), Expression (Assoc)); + + elsif + Nkind (Assoc) = N_Iterated_Component_Association + and then Present (Defining_Identifier (Assoc)) + then + Handle_Association_Choices + (Discrete_Choices (Assoc), Expression (Assoc)); + + -- Nkind (Assoc) = N_Iterated_Component_Association + -- with iterator_specification, or + -- Nkind (Assoc) = N_Iterated_Element_Association + -- with loop_parameter_specification + -- or iterator_specification + -- + -- It seems that we might also need to deal with + -- iterable/iterator_names and iterator_filters + -- within iterator_specifications, and range bounds + -- within loop_parameter_specifications, but the + -- utility of doing that seems very low. ??? + + else + Collect_Expression_Ids (Expression (Assoc)); + end if; + end if; + end Handle_Association; Next (Assoc); end loop; @@ -5619,10 +5709,8 @@ package body Sem_Util is -- to start scanning from the incomplete view, which is earlier on -- the entity chain. - elsif Nkind (Parent (B_Type)) = N_Full_Type_Declaration - and then Present (Incomplete_View (Parent (B_Type))) - then - Id := Incomplete_View (Parent (B_Type)); + elsif Present (Incomplete_View (B_Type)) then + Id := Incomplete_View (B_Type); -- If T is a derived from a type with an incomplete view declared -- elsewhere, that incomplete view is irrelevant, we want the @@ -5662,6 +5750,7 @@ package body Sem_Util is or else Is_Primitive (Id)) and then Parent_Kind (Parent (Id)) not in N_Formal_Subprogram_Declaration + and then not Is_Child_Unit (Id) then Is_Prim := False; @@ -6578,6 +6667,30 @@ package body Sem_Util is return Is_Class_Wide_Type (Typ) or else Needs_Finalization (Typ); end CW_Or_Needs_Finalization; + ------------------------- + -- Default_Constructor -- + ------------------------- + + function Default_Constructor (Typ : Entity_Id) return Entity_Id is + Construct : Elmt_Id; + begin + pragma Assert (Is_Type (Typ)); + if No (Constructor_Name (Typ)) or else No (Constructor_List (Typ)) then + return Empty; + end if; + + Construct := First_Elmt (Constructor_List (Typ)); + while Present (Construct) loop + if Parameter_Count (Elists.Node (Construct)) = 1 then + return Elists.Node (Construct); + end if; + + Next_Elmt (Construct); + end loop; + + return Empty; + end Default_Constructor; + --------------------- -- Defining_Entity -- --------------------- @@ -7946,6 +8059,7 @@ package body Sem_Util is -- but the error should be posted on it, not on the component. elsif Ekind (E) = E_Discriminant + and then Is_Not_Self_Hidden (E) and then Present (Scope (Def_Id)) and then Scope (Def_Id) /= Current_Scope then @@ -7971,7 +8085,10 @@ package body Sem_Util is -- Avoid cascaded messages with duplicate components in -- derived types. - if Ekind (E) in E_Component | E_Discriminant then + if Ekind (E) = E_Component + or else (Ekind (E) = E_Discriminant + and then Is_Not_Self_Hidden (E)) + then return; end if; end if; @@ -8002,20 +8119,7 @@ package body Sem_Util is -- If we fall through, declaration is OK, at least OK enough to continue - -- If Def_Id is a discriminant or a record component we are in the midst - -- of inheriting components in a derived record definition. Preserve - -- their Ekind and Etype. - - if Ekind (Def_Id) in E_Discriminant | E_Component then - null; - - -- If a type is already set, leave it alone (happens when a type - -- declaration is reanalyzed following a call to the optimizer). - - elsif Present (Etype (Def_Id)) then - null; - - else + if No (Etype (Def_Id)) then Set_Etype (Def_Id, Any_Type); -- avoid cascaded errors end if; @@ -8063,12 +8167,20 @@ package body Sem_Util is loop Ren := Renamed_Object (Id); + -- The reference renames a function result. Check the original + -- node in case expansion relocates the function call. + + -- Ren : ... renames Func_Call; + + if Nkind (Original_Node (Ren)) = N_Function_Call then + exit; + -- The reference renames an abstract state or a whole object -- Obj : ...; -- Ren : ... renames Obj; - if Is_Entity_Name (Ren) then + elsif Is_Entity_Name (Ren) then -- Do not follow a renaming that goes through a generic formal, -- because these entities are hidden and must not be referenced @@ -8081,14 +8193,6 @@ package body Sem_Util is Id := Entity (Ren); end if; - -- 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. @@ -8843,9 +8947,10 @@ package body Sem_Util is -------------------------- procedure Find_Overlaid_Entity - (N : Node_Id; - Ent : out Entity_Id; - Off : out Boolean) + (N : Node_Id; + Ent : out Entity_Id; + Ovrl_Typ : out Entity_Id; + Off : out Boolean) is pragma Assert (Nkind (N) = N_Attribute_Definition_Clause @@ -8867,8 +8972,9 @@ package body Sem_Util is -- In the second case, the expr is either Y'Address, or recursively a -- constant that eventually references Y'Address. - Ent := Empty; - Off := False; + Ent := Empty; + Ovrl_Typ := Empty; + Off := False; Expr := Expression (N); @@ -8898,6 +9004,8 @@ package body Sem_Util is end if; end loop; + Ovrl_Typ := Etype (Expr); + -- This loop checks the form of the prefix for an entity, using -- recursion to deal with intermediate components. @@ -8916,8 +9024,10 @@ package body Sem_Util is pragma Assert (not Expander_Active and then Is_Concurrent_Type (Scope (Ent))); - Ent := Empty; + Ent := Empty; + Ovrl_Typ := Empty; end if; + return; -- Check for components @@ -10152,63 +10262,69 @@ package body Sem_Util is Strval => String_From_Name_Buffer); end Get_Default_External_Name; - -------------------------- - -- Get_Enclosing_Object -- - -------------------------- + -------------------------------- + -- Get_Enclosing_Ghost_Entity -- + -------------------------------- - function Get_Enclosing_Object (N : Node_Id) return Entity_Id is + function Get_Enclosing_Ghost_Entity (N : Node_Id) return Entity_Id is begin if Is_Entity_Name (N) then return Entity (N); else case Nkind (N) is - when N_Indexed_Component + when N_Attribute_Reference + | N_Explicit_Dereference + | N_Indexed_Component | N_Selected_Component | N_Slice => - -- If not generating code, a dereference may be left implicit. - -- In thoses cases, return Empty. + return Get_Enclosing_Ghost_Entity (Prefix (N)); - if Is_Access_Type (Etype (Prefix (N))) then - return Empty; - else - return Get_Enclosing_Object (Prefix (N)); - end if; + when N_Function_Call => + return Get_Called_Entity (N); - when N_Type_Conversion => - return Get_Enclosing_Object (Expression (N)); + -- We are interested in the target type, because if it is ghost, + -- then the object is ghost as well and if it is non-ghost, then + -- its expression can't be ghost. + + when N_Qualified_Expression + | N_Type_Conversion + | N_Unchecked_Type_Conversion + => + return Entity (Subtype_Mark (N)); when others => return Empty; end case; end if; - end Get_Enclosing_Object; + end Get_Enclosing_Ghost_Entity; - ------------------------------- - -- Get_Enclosing_Deep_Object -- - ------------------------------- + -------------------------- + -- Get_Enclosing_Object -- + -------------------------- - function Get_Enclosing_Deep_Object (N : Node_Id) return Entity_Id is + function Get_Enclosing_Object (N : Node_Id) return Entity_Id is begin if Is_Entity_Name (N) then return Entity (N); else case Nkind (N) is - when N_Explicit_Dereference - | N_Indexed_Component + when N_Indexed_Component | N_Selected_Component | N_Slice => - return Get_Enclosing_Deep_Object (Prefix (N)); + return Get_Enclosing_Object (Prefix (N)); - when N_Type_Conversion => - return Get_Enclosing_Deep_Object (Expression (N)); + when N_Type_Conversion + | N_Unchecked_Type_Conversion + => + return Get_Enclosing_Object (Expression (N)); when others => return Empty; end case; end if; - end Get_Enclosing_Deep_Object; + end Get_Enclosing_Object; --------------------------- -- Get_Enum_Lit_From_Pos -- @@ -12368,9 +12484,14 @@ package body Sem_Util is while Present (Node) loop case Nkind (Node) is - when N_Null_Statement | N_Call_Marker | N_Raise_xxx_Error => + when N_Null_Statement | N_Call_Marker => null; + when N_Raise_xxx_Error => + if Comes_From_Source (Node) then + return False; + end if; + when N_Object_Declaration => if Present (Expression (Node)) and then not Side_Effect_Free (Expression (Node)) @@ -12717,6 +12838,150 @@ package body Sem_Util is return False; end Has_Overriding_Initialize; + ----------------------------- + -- Has_Potentially_Invalid -- + ----------------------------- + + function Has_Potentially_Invalid (E : Entity_Id) return Boolean is + + function Denotes_Invalid_Parameter + (Expr : Node_Id; + Param : Entity_Id) + return Boolean; + -- Returns True iff expression Expr denotes a formal parameter or + -- function Param (through its attribute Result). + + ------------------------------- + -- Denotes_Invalid_Parameter -- + ------------------------------- + + function Denotes_Invalid_Parameter + (Expr : Node_Id; + Param : Entity_Id) return Boolean is + begin + if Nkind (Expr) in N_Identifier | N_Expanded_Name then + return Entity (Expr) = Param; + else + pragma Assert (Is_Attribute_Result (Expr)); + return Entity (Prefix (Expr)) = Param; + end if; + end Denotes_Invalid_Parameter; + + -- Start of processing for Has_Potentially_Invalid + + begin + -- When analyzing, we checked all syntax legality rules for the aspect + -- Potentially_Invalid, but didn't store the property anywhere (e.g. as + -- an Einfo flag). To query the property we look directly at the AST, + -- but now without any syntactic checks. + + case Ekind (E) is + -- Constants have this aspect attached directly; for deferred + -- constants, the aspect is attached to the partial view. + + when E_Constant => + return Has_Aspect (E, Aspect_Potentially_Invalid); + + -- Variables have this aspect attached directly + + when E_Variable => + return Has_Aspect (E, Aspect_Potentially_Invalid); + + when Formal_Kind + | E_Function + => + -- Instances of Ada.Unchecked_Conversion is a special case. Look + -- for the aspect on the generic instance. The aspect necessarily + -- applies to the function result. + + if Is_Unchecked_Conversion_Instance (E) then + declare + Wrapper_Pkg : constant Node_Id := + Defining_Unit_Name (Parent (Subprogram_Spec (E))); + pragma Assert (Is_Wrapper_Package (Wrapper_Pkg)); + Instance : constant Entity_Id := Defining_Unit_Name + (Get_Unit_Instantiation_Node (Wrapper_Pkg)); + begin + return Has_Aspect (Instance, Aspect_Potentially_Invalid); + end; + end if; + + -- Formal parameters and functions have the Potentially_Invalid + -- aspect attached to the subprogram entity and must be listed in + -- the aspect expression. + + declare + Subp_Id : Entity_Id; + Aspect_Expr : Node_Id; + Param_Expr : Node_Id; + Assoc : Node_Id; + + begin + if Is_Formal (E) then + Subp_Id := Scope (E); + else + Subp_Id := E; + end if; + + if Has_Aspect (Subp_Id, Aspect_Potentially_Invalid) then + Aspect_Expr := + Find_Value_Of_Aspect + (Subp_Id, Aspect_Potentially_Invalid); + + -- Aspect expression is either an aggregate with an optional + -- Boolean expression (which defaults to True), e.g.: + -- + -- function F (X : Integer) return Integer + -- with Potentially_Invalid => (X => True, F'Result); + + if Nkind (Aspect_Expr) = N_Aggregate then + + if Present (Component_Associations (Aspect_Expr)) then + Assoc := First (Component_Associations (Aspect_Expr)); + + while Present (Assoc) loop + if Denotes_Invalid_Parameter + (First (Choices (Assoc)), E) + then + return + Is_True + (Static_Boolean (Expression (Assoc))); + end if; + + Next (Assoc); + end loop; + end if; + + Param_Expr := First (Expressions (Aspect_Expr)); + + while Present (Param_Expr) loop + if Denotes_Invalid_Parameter (Param_Expr, E) then + return True; + end if; + + Next (Param_Expr); + end loop; + + return False; + + -- or it is a single identifier, e.g.: + -- + -- function F (X : Integer) return Integer + -- with Potentially_Invalid => X; + + else + return Denotes_Invalid_Parameter (Aspect_Expr, E); + end if; + else + return False; + end if; + end; + + when others => + raise Program_Error; + end case; + end Has_Potentially_Invalid; + -------------------------------------- -- Has_Preelaborable_Initialization -- -------------------------------------- @@ -17815,6 +18080,27 @@ package body Sem_Util is return Nkind (Spec_Decl) in N_Generic_Declaration; end Is_Generic_Declaration_Or_Body; + -------------------------- + -- Is_In_Context_Clause -- + -------------------------- + + function Is_In_Context_Clause (N : Node_Id) return Boolean is + Plist : List_Id; + Parent_Node : Node_Id; + + begin + if Is_List_Member (N) then + Plist := List_Containing (N); + Parent_Node := Parent (Plist); + + return Present (Parent_Node) + and then Nkind (Parent_Node) = N_Compilation_Unit + and then Context_Items (Parent_Node) = Plist; + end if; + + return False; + end Is_In_Context_Clause; + --------------------------- -- Is_Independent_Object -- --------------------------- @@ -18276,6 +18562,7 @@ package body Sem_Util is case Nkind (N) is when N_Indexed_Component + | N_Selected_Component | N_Slice => return @@ -18287,13 +18574,6 @@ package body Sem_Util is when N_Attribute_Reference => return Attribute_Name (N) in Name_Input | Name_Old | Name_Result; - when N_Selected_Component => - return - Is_Name_Reference (Selector_Name (N)) - and then - (Is_Name_Reference (Prefix (N)) - or else Is_Access_Type (Etype (Prefix (N)))); - when N_Explicit_Dereference => return True; @@ -20863,6 +21143,7 @@ package body Sem_Util is or else Nam = Name_Pre or else Nam = Name_Pre_Class or else Nam = Name_Precondition + or else Nam = Name_Program_Exit or else Nam = Name_Refined_Depends or else Nam = Name_Refined_Global or else Nam = Name_Refined_Post @@ -21800,7 +22081,7 @@ package body Sem_Util is Set_Last_Assignment (Ent, Empty); end if; - if Is_Object (Ent) then + if Is_Object (Ent) and then Ekind (Ent) not in Record_Field_Kind then if not Last_Assignment_Only then Kill_Checks (Ent); Set_Current_Value (Ent, Empty); @@ -21876,20 +22157,6 @@ package body Sem_Util is end loop Scope_Loop; end Kill_Current_Values; - -------------------------- - -- Kill_Size_Check_Code -- - -------------------------- - - procedure Kill_Size_Check_Code (E : Entity_Id) is - begin - if (Ekind (E) = E_Constant or else Ekind (E) = E_Variable) - and then Present (Size_Check_Code (E)) - then - Remove (Size_Check_Code (E)); - Set_Size_Check_Code (E, Empty); - end if; - end Kill_Size_Check_Code; - -------------------- -- Known_Non_Null -- -------------------- @@ -23078,11 +23345,6 @@ package body Sem_Util is then return True; - -- Mutably tagged types require default initialization - - elsif Is_Mutably_Tagged_CW_Equivalent_Type (Typ) then - return True; - -- If Initialize/Normalize_Scalars is in effect, string objects also -- need initialization, unless they are created in the course of -- expanding an aggregate (since in the latter case they will be @@ -23850,7 +24112,7 @@ package body Sem_Util is Result := N; - if N > Empty_Or_Error then + if N not in Empty | Error then pragma Assert (Nkind (N) not in N_Entity); Result := New_Copy (N); @@ -23931,7 +24193,7 @@ package body Sem_Util is Result := Id; - if Id > Empty_Or_Error then + if Id not in Empty | Error then pragma Assert (Nkind (Id) in N_Entity); -- Determine whether the entity has a corresponding new entity @@ -24045,7 +24307,9 @@ package body Sem_Util is Next (Old_Act); end loop; - pragma Assert (Replaced); + if Nkind (Old_Call) /= N_Function_Call then + pragma Assert (Replaced); + end if; end Update_Controlling_Argument; ------------------------------- @@ -24902,7 +25166,7 @@ package body Sem_Util is -- In case of a call rewritten in GNATprove mode while "inlining -- for proof" go to the original call. - elsif Nkind (Par) = N_Null_Statement then + elsif Nkind (Par) in N_Null_Statement | N_Block_Statement then pragma Assert (GNATprove_Mode and then @@ -25336,6 +25600,8 @@ package body Sem_Util is end if; if Nkind (P) = N_Selected_Component + -- and then Ekind (Entity (Selector_Name (P))) + -- in Record_Field_Kind and then Present (Entry_Formal (Entity (Selector_Name (P)))) then -- Case of a reference to an entry formal @@ -25498,16 +25764,18 @@ package body Sem_Util is if Sure and then Modification_Comes_From_Source + and then Ekind (Ent) in E_Constant | E_Variable and then Overlays_Constant (Ent) and then Address_Clause_Overlay_Warnings then declare Addr : constant Node_Id := Address_Clause (Ent); O_Ent : Entity_Id; + O_Typ : Entity_Id; Off : Boolean; begin - Find_Overlaid_Entity (Addr, O_Ent, Off); + Find_Overlaid_Entity (Addr, O_Ent, O_Typ, Off); Error_Msg_Sloc := Sloc (Addr); Error_Msg_NE @@ -26066,6 +26334,24 @@ package body Sem_Util is return Empty; end Param_Entity; + --------------------- + -- Parameter_Count -- + --------------------- + + function Parameter_Count (Subp : Entity_Id) return Nat is + Result : Nat := 0; + Param : Entity_Id; + begin + Param := First_Entity (Subp); + while Present (Param) loop + Result := Result + 1; + + Param := Next_Entity (Param); + end loop; + + return Result; + end Parameter_Count; + ---------------------- -- Policy_In_Effect -- ---------------------- @@ -28409,12 +28695,6 @@ package body Sem_Util is return False; end if; - if Ekind (Entity (Selector_Name (N))) not in - E_Component | E_Discriminant - then - return False; - end if; - declare Comp : constant Entity_Id := Original_Record_Component (Entity (Selector_Name (N))); @@ -28937,9 +29217,10 @@ package body Sem_Util is ------------------------------ function Ultimate_Overlaid_Entity (E : Entity_Id) return Entity_Id is - Address : Node_Id; - Alias : Entity_Id := E; - Offset : Boolean; + Address : Node_Id; + Alias : Entity_Id := E; + Offset : Boolean; + Ovrl_Typ : Entity_Id; begin -- Currently this routine is only called for stand-alone objects that @@ -28951,7 +29232,7 @@ package body Sem_Util is loop Address := Address_Clause (Alias); if Present (Address) then - Find_Overlaid_Entity (Address, Alias, Offset); + Find_Overlaid_Entity (Address, Alias, Ovrl_Typ, Offset); if Present (Alias) then null; else |