------------------------------------------------------- ------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A N A L Y Z E R . F I N D E R -- -- -- -- B o d y -- -- -- -- Copyright (C) 2005-2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina is distributed in the hope that it will be -- -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- -- Public License for more details. You should have received a copy of the -- -- GNU General Public License distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Namet; with Ocarina.Nutils; with Ocarina.Analyzer.Naming_Rules; with Ocarina.Analyzer.Messages; with Ocarina.Entities.Components; with Ocarina.Parser; package body Ocarina.Analyzer.Finder is use Namet; use Ocarina.Parser; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Entities; use Ocarina.Entities.Components; use Ocarina.Analyzer.Naming_Rules; use Ocarina.Analyzer.Messages; function Find_AADL_Declaration_Classifier (Root : Node_Id; Package_Identifier : Node_Id; Declaration_Identifier : Node_Id; Declaration_Kinds : Node_Kind_Array; Options : Analyzer_Options) return Node_Id; function Find_Subclause_Declaration_Classifier (Component : Node_Id; Declaration_Identifier : Node_Id; Subclause_Kinds : Node_Kind_Array) return Node_Id; function Filter_Declarations_According_To_Modes (Declaration_Node : Node_Id; In_Modes : Node_Id) return Node_Id; -------------------------------------------- -- Filter_Declarations_According_To_Modes -- -------------------------------------------- function Filter_Declarations_According_To_Modes (Declaration_Node : Node_Id; In_Modes : Node_Id) return Node_Id is Pointed_Node : Node_Id := Declaration_Node; Homonym_Node : Node_Id; Homonym_Identifier : Node_Id; Success : Boolean; Was_First_Homonym : Boolean; Required_Mode : Node_Id; Present_Mode : Node_Id; Name_Id_1 : Name_Id; Name_Id_2 : Name_Id; Name_Id_1b : Name_Id; Name_Id_2b : Name_Id; begin Homonym_Node := Pointed_Node; while Present (Homonym_Node) loop Success := True; Was_First_Homonym := (Homonym_Node = Pointed_Node); if Have_Modes (In_Modes) then if not Have_Modes (Ocarina.Nodes.In_Modes (Homonym_Node)) then Success := False; -- If we look for some in_modes and there is none, the -- test fails else Required_Mode := First_Node (Modes (In_Modes)); Success := False; while Present (Required_Mode) loop Present_Mode := First_Node (Modes (Ocarina.Nodes.In_Modes (Homonym_Node))); while Present (Present_Mode) loop if Kind (Present_Mode) = Kind (Required_Mode) then if Kind (Required_Mode) = K_Entity_Reference then Name_Id_1 := Get_Name_Of_Entity_Reference (Present_Mode); Name_Id_2 := Get_Name_Of_Entity_Reference (Required_Mode); Success := (Name_Id_1 = Name_Id_2) or else Success; elsif Kind (Required_Mode) = K_Pair_Of_Entity_References and then (Second_Reference (Required_Mode) /= No_Node) = (Second_Reference (Present_Mode) /= No_Node) then if Second_Reference (Required_Mode) = No_Node then Name_Id_1 := Get_Name_Of_Entity_Reference (First_Reference (Present_Mode)); Name_Id_2 := Get_Name_Of_Entity_Reference (First_Reference (Required_Mode)); Success := (Name_Id_1 = Name_Id_2) or else Success; else Name_Id_1 := Get_Name_Of_Entity_Reference (First_Reference (Present_Mode)); Name_Id_2 := Get_Name_Of_Entity_Reference (First_Reference (Required_Mode)); Name_Id_1b := Get_Name_Of_Entity_Reference (Second_Reference (Present_Mode)); Name_Id_2b := Get_Name_Of_Entity_Reference (Second_Reference (Required_Mode)); Success := ((Name_Id_1 = Name_Id_2) and then (Name_Id_1b = Name_Id_2b)) or else Success; end if; end if; end if; exit when Success; Present_Mode := Next_Node (Present_Mode); end loop; exit when not Success; Required_Mode := Next_Node (Required_Mode); end loop; -- For each required mode, we look for it in the -- in_modes statement end if; end if; if not Success then Homonym_Identifier := Remove_From_Homonyms (Identifier (Pointed_Node), Identifier (Homonym_Node)); -- Beware: Remove_From_Homonyms only handles -- identifiers. else Homonym_Identifier := Homonym (Identifier (Homonym_Node)); end if; if Present (Homonym_Identifier) then Homonym_Node := Corresponding_Entity (Homonym_Identifier); else Homonym_Node := No_Node; end if; if Was_First_Homonym and then not Success then Pointed_Node := Homonym_Node; end if; end loop; return Pointed_Node; end Filter_Declarations_According_To_Modes; -------------------------------------- -- Find_AADL_Declaration_Classifier -- -------------------------------------- function Find_AADL_Declaration_Classifier (Root : Node_Id; Package_Identifier : Node_Id; Declaration_Identifier : Node_Id; Declaration_Kinds : Node_Kind_Array; Options : Analyzer_Options) return Node_Id is pragma Unreferenced (Options); pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (No (Package_Identifier) or else Kind (Package_Identifier) = K_Identifier); pragma Assert (Kind (Declaration_Identifier) = K_Identifier); pragma Assert (Declaration_Kinds'Length > 0); Pack : Node_Id; Pointed_Node : Node_Id := No_Node; Homonym_Node : Node_Id; Homonym_Identifier : Node_Id; Success : Boolean; Was_First_Homonym : Boolean; begin if Present (Package_Identifier) then Pack := Node_In_Scope (Package_Identifier, Entity_Scope (Root)); Pointed_Node := No_Node; -- Node_In_Scope returns a node with all its homonyms. We -- have to look for a package in this list. Naming rules -- ensure there is at most one package in the list. while Present (Pack) and then Kind (Pack) /= K_Package_Specification loop Homonym_Identifier := Homonym (Identifier (Pack)); if Present (Homonym_Identifier) then Pack := Corresponding_Entity (Homonym_Identifier); else Pack := No_Node; end if; end loop; -- If the package has been found, we look for the -- declaration if Present (Pack) then Pointed_Node := Node_In_Scope (Declaration_Identifier, Entity_Scope (Pack)); if Current_Scope /= Entity_Scope (Pack) then -- If the search is not done from the local package, -- then we must ignore the private declarations Homonym_Node := Pointed_Node; while Present (Homonym_Node) loop Was_First_Homonym := (Homonym_Node = Pointed_Node); Success := not Is_Private (Homonym_Node); if not Success then Homonym_Identifier := Remove_From_Homonyms (Identifier (Pointed_Node), Identifier (Homonym_Node)); -- Beware: Remove_From_Homonyms only handles -- identifiers. else Homonym_Identifier := Homonym (Identifier (Homonym_Node)); end if; if Present (Homonym_Identifier) then Homonym_Node := Corresponding_Entity (Homonym_Identifier); else Homonym_Node := No_Node; end if; if Was_First_Homonym and then not Success then Pointed_Node := Homonym_Node; end if; end loop; end if; end if; else Pointed_Node := Node_In_Scope (Declaration_Identifier, Current_Scope); -- Current_Scope is supposed to be the one of the package end if; -- We then filter out the node kinds we do not seek Homonym_Node := Pointed_Node; while Present (Homonym_Node) loop Success := False; Was_First_Homonym := (Homonym_Node = Pointed_Node); for K in Declaration_Kinds'Range loop Success := (Kind (Pointed_Node) = Declaration_Kinds (K)) or else Success; end loop; if not Success then Homonym_Identifier := Remove_From_Homonyms (Identifier (Pointed_Node), Identifier (Homonym_Node)); -- Beware: Remove_From_Homonyms only handles -- identifiers. else Homonym_Identifier := Homonym (Identifier (Homonym_Node)); end if; if Present (Homonym_Identifier) then Homonym_Node := Corresponding_Entity (Homonym_Identifier); else Homonym_Node := No_Node; end if; if Was_First_Homonym and then not Success then Pointed_Node := Homonym_Node; end if; end loop; return Pointed_Node; end Find_AADL_Declaration_Classifier; ------------------------------ -- Find_All_Component_Types -- ------------------------------ function Find_All_Component_Types (Root : Node_Id; Namespace : Node_Id := No_Node) return Entity_List is begin return Find_All_Declarations (Root, (1 => K_Component_Type), Namespace); end Find_All_Component_Types; --------------------------- -- Find_All_Declarations -- --------------------------- function Find_All_Declarations (Root : Node_Id; Kinds : Node_Kind_Array; Namespace : Node_Id := No_Node) return Entity_List is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (No (Namespace) or else Kind (Namespace) = K_AADL_Specification or else Kind (Namespace) = K_Package_Specification); EL : Entity_List := Empty_Entity_List; List_Node : Node_Id; begin if No (Namespace) then Select_Nodes (Ocarina.Nodes.Declarations (Root), Kinds, EL.First_Entity, EL.Last_Entity); -- We first get the declarations of the unnamed namespace if not Is_Empty (Ocarina.Nodes.Declarations (Root)) then List_Node := Ocarina.Nodes.First_Node (Ocarina.Nodes.Declarations (Root)); while Present (List_Node) loop if Kind (List_Node) = K_Package_Specification then -- Then those of the packages Select_Nodes (Ocarina.Nodes.Declarations (List_Node), Kinds, EL.First_Entity, EL.Last_Entity); end if; List_Node := Next_Node (List_Node); end loop; end if; else Select_Nodes (Ocarina.Nodes.Declarations (Namespace), Kinds, EL.First_Entity, EL.Last_Entity); end if; return EL; end Find_All_Declarations; ----------------------- -- Find_All_Features -- ----------------------- function Find_All_Features (AADL_Declaration : Node_Id) return Entity_List is begin return Find_All_Subclauses (AADL_Declaration, (K_Port_Spec, K_Parameter, K_Port_Group_Spec, K_Subcomponent_Access)); end Find_All_Features; ------------------------------------ -- Find_All_Property_Associations -- ------------------------------------ function Find_All_Property_Associations (AADL_Declaration : Node_Id) return Entity_List is begin return Find_All_Subclauses (AADL_Declaration, (1 => K_Property_Association)); end Find_All_Property_Associations; ------------------------------------------------------- -- Find_All_Subclause_Declarations_Except_Properties -- ------------------------------------------------------- function Find_All_Subclause_Declarations_Except_Properties (AADL_Declaration : Node_Id) return Entity_List is begin return Find_All_Subclauses (AADL_Declaration, (K_Port_Spec, K_Parameter, K_Port_Group_Spec, K_Subcomponent_Access, K_Flow_Spec, K_Flow_Implementation, K_End_To_End_Flow_Spec, K_Flow_Implementation_Refinement, K_End_To_End_Flow_Refinement, K_Mode, K_Connection, K_Subprogram_Call, K_Subprogram_Call_Sequence)); end Find_All_Subclause_Declarations_Except_Properties; ------------------------- -- Find_All_Subclauses -- ------------------------- function Find_All_Subclauses (AADL_Declaration : Node_Id; Kinds : Node_Kind_Array) return Entity_List is pragma Assert (Kind (AADL_Declaration) = K_Component_Implementation or else Kind (AADL_Declaration) = K_Component_Type or else Kind (AADL_Declaration) = K_Port_Group_Type); EL : Entity_List := Empty_Entity_List; List_Node : Node_Id; Declaration_Node : Node_Id; begin case Kind (AADL_Declaration) is when K_Component_Type => Declaration_Node := AADL_Declaration; while Present (Declaration_Node) and then Kind (Declaration_Node) = K_Component_Type loop Select_Nodes (Features (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Flows (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Properties (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); if Present (Parent (Declaration_Node)) then Declaration_Node := Corresponding_Entity (Identifier (Parent (Declaration_Node))); else Declaration_Node := No_Node; end if; end loop; when K_Component_Implementation => -- We first scan the corresponding component type and its -- parents if Component_Type_Identifier (AADL_Declaration) /= No_Node then Declaration_Node := Corresponding_Entity (Component_Type_Identifier (AADL_Declaration)); while Present (Declaration_Node) and then Kind (Declaration_Node) = K_Component_Type loop Select_Nodes (Features (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Flows (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Properties (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); if Present (Parent (Declaration_Node)) then Declaration_Node := Corresponding_Entity (Identifier (Parent (Declaration_Node))); else Declaration_Node := No_Node; end if; end loop; end if; -- Then we scan the component implementation and its -- parents Declaration_Node := AADL_Declaration; while Present (Declaration_Node) and then Kind (Declaration_Node) = K_Component_Implementation loop Select_Nodes (Refines_Type (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Subcomponents (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Calls (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); if not Is_Empty (Calls (Declaration_Node)) then List_Node := Ocarina.Nodes.First_Node (Calls (Declaration_Node)); while Present (List_Node) loop Select_Nodes (Subprogram_Calls (List_Node), Kinds, EL.First_Entity, EL.Last_Entity); List_Node := Next_Node (List_Node); end loop; end if; Select_Nodes (Connections (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Flows (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Modes (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Properties (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); if Present (Parent (Declaration_Node)) then Declaration_Node := Corresponding_Entity (Identifier (Parent (Declaration_Node))); else Declaration_Node := No_Node; end if; end loop; when K_Port_Group_Type => Declaration_Node := AADL_Declaration; while Present (Declaration_Node) and then Kind (Declaration_Node) = K_Port_Group_Type loop Select_Nodes (Features (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); Select_Nodes (Properties (Declaration_Node), Kinds, EL.First_Entity, EL.Last_Entity); if Present (Parent (Declaration_Node)) then Declaration_Node := Corresponding_Entity (Identifier (Parent (Declaration_Node))); else Declaration_Node := No_Node; end if; end loop; when others => DAE (Node1 => AADL_Declaration, Message1 => " is not an adequate AADL declaration"); return (No_Node, No_Node); end case; return EL; end Find_All_Subclauses; -------------------------------- -- Find_All_Top_Level_Systems -- -------------------------------- function Find_All_Top_Level_Systems (Root : Node_Id) return Entity_List is pragma Assert (Kind (Root) = K_AADL_Specification); System_List : Entity_List := Empty_Entity_List; Top_Level_Systems : Entity_List := Empty_Entity_List; List_Node : Node_Id; Kept_Node : Node_Id; begin System_List := Find_All_Declarations (Root, (1 => K_Component_Implementation), No_Node); -- First, we only retrieve the component implementations List_Node := System_List.First_Entity; while Present (List_Node) loop if Component_Category'Val (Category (List_Node)) = CC_System and then Is_Empty (Features (Corresponding_Entity (Component_Type_Identifier (List_Node)))) then -- If the system implementation corresponds to a type -- that does not have any feature, we keep it. Kept_Node := List_Node; else Kept_Node := No_Node; end if; List_Node := Next_Entity (List_Node); if Present (Kept_Node) then Set_Next_Entity (Kept_Node, Top_Level_Systems.First_Entity); if Top_Level_Systems.Last_Entity = No_Node then Top_Level_Systems.Last_Entity := Kept_Node; end if; Top_Level_Systems.First_Entity := Kept_Node; end if; end loop; return Top_Level_Systems; end Find_All_Top_Level_Systems; ------------------------------- -- Find_Component_Classifier -- ------------------------------- function Find_Component_Classifier (Root : Node_Id; Package_Identifier : Node_Id; Component_Identifier : Node_Id; Options : Analyzer_Options) return Node_Id is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (No (Package_Identifier) or else Kind (Package_Identifier) = K_Identifier); pragma Assert (Kind (Component_Identifier) = K_Identifier); begin return Find_AADL_Declaration_Classifier (Root, Package_Identifier, Component_Identifier, (K_Component_Type, K_Component_Implementation), Options); end Find_Component_Classifier; --------------------- -- Find_Connection -- --------------------- function Find_Connection (Component : Node_Id; Connection_Identifier : Node_Id; In_Modes : Node_Id := No_Node) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Connection_Identifier) = K_Identifier); Pointed_Node : Node_Id; begin Pointed_Node := Find_Subclause_Declaration_Classifier (Component, Connection_Identifier, (1 => K_Connection)); Pointed_Node := Filter_Declarations_According_To_Modes (Pointed_Node, In_Modes); return Pointed_Node; end Find_Connection; ------------------ -- Find_Feature -- ------------------ function Find_Feature (Component : Node_Id; Feature_Identifier : Node_Id) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation or else Kind (Component) = K_Component_Type or else Kind (Component) = K_Port_Group_Type); pragma Assert (Kind (Feature_Identifier) = K_Identifier); Pointed_Node : Node_Id; begin Pointed_Node := Find_Subclause_Declaration_Classifier (Component, Feature_Identifier, (K_Port_Spec, K_Parameter, K_Port_Group_Spec, K_Subcomponent_Access, K_Subprogram_Spec)); if No (Pointed_Node) and then Kind (Component) = K_Port_Group_Type and then Present (Inverse_Of (Component)) then Pointed_Node := Find_Feature (Get_Referenced_Entity (Inverse_Of (Component)), Feature_Identifier); Pointed_Node := Inversed_Entity (Pointed_Node); end if; return Pointed_Node; end Find_Feature; -------------------- -- Find_Flow_Spec -- -------------------- function Find_Flow_Spec (Component : Node_Id; Flow_Identifier : Node_Id) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation or else Kind (Component) = K_Component_Type); pragma Assert (Kind (Flow_Identifier) = K_Identifier); begin return Find_Subclause_Declaration_Classifier (Component, Flow_Identifier, (1 => K_Flow_Spec)); end Find_Flow_Spec; --------------- -- Find_Mode -- --------------- function Find_Mode (Component : Node_Id; Mode_Identifier : Node_Id) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation or else Kind (Component) = K_Component_Type or else Kind (Component) = K_Port_Group_Type); pragma Assert (Kind (Mode_Identifier) = K_Identifier); begin return Find_Subclause_Declaration_Classifier (Component, Mode_Identifier, (1 => K_Mode)); end Find_Mode; -------------------------------- -- Find_Port_Group_Classifier -- -------------------------------- function Find_Port_Group_Classifier (Root : Node_Id; Package_Identifier : Node_Id; Port_Group_Identifier : Node_Id; Options : Analyzer_Options) return Node_Id is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (No (Package_Identifier) or else Kind (Package_Identifier) = K_Identifier); pragma Assert (Kind (Port_Group_Identifier) = K_Identifier); begin return Find_AADL_Declaration_Classifier (Root, Package_Identifier, Port_Group_Identifier, (1 => K_Port_Group_Type), Options); end Find_Port_Group_Classifier; ------------------------------- -- Find_Property_Association -- ------------------------------- function Find_Property_Association (AADL_Declaration : Node_Id; Property_Association_Name : Name_Id) return Node_Id is pragma Assert (Present (AADL_Declaration)); All_Properties : constant Entity_List := Find_All_Property_Associations (AADL_Declaration); List_Node : Node_Id; begin if All_Properties /= Empty_Entity_List then List_Node := All_Properties.First_Entity; while Present (List_Node) loop if Name (Identifier (List_Node)) = Property_Association_Name then return List_Node; end if; List_Node := Next_Entity (List_Node); end loop; end if; return No_Node; end Find_Property_Association; -------------------------- -- Find_Property_Entity -- -------------------------- function Find_Property_Entity (Root : Node_Id; Property_Set_Identifier : Node_Id; Property_Identifier : Node_Id; Options : Analyzer_Options) return Node_Id is pragma Unreferenced (Options); pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (No (Property_Set_Identifier) or else Kind (Property_Set_Identifier) = K_Identifier); pragma Assert (Kind (Property_Identifier) = K_Identifier); Property_Set : Node_Id; Found_Property_Declaration : Node_Id := No_Node; begin if Present (Property_Set_Identifier) then Property_Set := Node_In_Scope (Property_Set_Identifier, Entity_Scope (Root)); -- If we found the property set, then we look for the -- property in it. if Present (Property_Set) then Found_Property_Declaration := Node_In_Scope (Property_Identifier, Entity_Scope (Property_Set)); else Found_Property_Declaration := No_Node; end if; else if Present (Current_Scope) and then Kind (Corresponding_Entity (Current_Scope)) = K_Property_Set then -- If we are in a property set, we search here Found_Property_Declaration := Node_In_Scope (Property_Identifier, Current_Scope); end if; -- If we did not find anything so far, we try the implicit -- property sets. if No (Found_Property_Declaration) then for S in Standard_Property_Sets loop Set_Str_To_Name_Buffer (Image (S)); Property_Set := Node_In_Scope (Name_Find, Entity_Scope (Root)); if Present (Property_Set) then Found_Property_Declaration := Node_In_Scope (Property_Identifier, Entity_Scope (Property_Set)); end if; exit when Present (Found_Property_Declaration); end loop; end if; end if; return Found_Property_Declaration; end Find_Property_Entity; -------------------- -- Find_Subclause -- -------------------- function Find_Subclause (Component : Node_Id; Identifier : Node_Id) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation or else Kind (Component) = K_Component_Type); pragma Assert (Kind (Identifier) = K_Identifier); begin return Find_Subclause_Declaration_Classifier (Component, Identifier, (K_Flow_Spec, K_Flow_Implementation, K_Flow_Implementation_Refinement, K_End_To_End_Flow_Spec, K_End_To_End_Flow_Refinement, K_Connection, K_Subcomponent, K_Port_Spec, K_Parameter, K_Port_Group_Spec, K_Subcomponent_Access, K_Subprogram_Spec, K_Mode, K_Subprogram_Call)); end Find_Subclause; ------------------------------------------- -- Find_Subclause_Declaration_Classifier -- ------------------------------------------- function Find_Subclause_Declaration_Classifier (Component : Node_Id; Declaration_Identifier : Node_Id; Subclause_Kinds : Node_Kind_Array) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation or else Kind (Component) = K_Component_Type or else Kind (Component) = K_Port_Group_Type); pragma Assert (Kind (Declaration_Identifier) = K_Identifier); pragma Assert (Subclause_Kinds'Length > 0); Homonym_Node : Node_Id := No_Node; Homonym_Identifier : Node_Id := No_Node; Pointed_Node : Node_Id := No_Node; Success : Boolean; Was_First_Homonym : Boolean; begin Pointed_Node := Node_In_Scope (Declaration_Identifier, Entity_Scope (Component)); while Present (Homonym_Node) loop Success := False; Was_First_Homonym := (Homonym_Node = Pointed_Node); for K in Subclause_Kinds'Range loop Success := (Kind (Pointed_Node) = Subclause_Kinds (K)) or else Success; end loop; if not Success then Homonym_Identifier := Remove_From_Homonyms (Identifier (Pointed_Node), Identifier (Homonym_Node)); -- Beware: Remove_From_Homonyms only handles -- identifiers. else Homonym_Identifier := Homonym (Identifier (Homonym_Node)); end if; if Present (Homonym_Identifier) then Homonym_Node := Corresponding_Entity (Homonym_Identifier); else Homonym_Node := No_Node; end if; if Was_First_Homonym and then not Success then Pointed_Node := Homonym_Node; end if; end loop; return Pointed_Node; end Find_Subclause_Declaration_Classifier; ----------------------- -- Find_Subcomponent -- ----------------------- function Find_Subcomponent (Component : Node_Id; Subcomponent_Identifier : Node_Id; In_Modes : Node_Id := No_Node) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Subcomponent_Identifier) = K_Identifier); Pointed_Node : Node_Id; begin Pointed_Node := Find_Subclause_Declaration_Classifier (Component, Subcomponent_Identifier, (1 => K_Subcomponent)); Pointed_Node := Filter_Declarations_According_To_Modes (Pointed_Node, In_Modes); return Pointed_Node; end Find_Subcomponent; -------------------------- -- Find_Subprogram_Call -- -------------------------- function Find_Subprogram_Call (Component : Node_Id; Call_Identifier : Node_Id; In_Modes : Node_Id := No_Node) return Node_Id is pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Call_Identifier) = K_Identifier); Pointed_Node : Node_Id; begin Pointed_Node := Find_Subclause_Declaration_Classifier (Component, Call_Identifier, (1 => K_Subprogram_Call)); Pointed_Node := Filter_Declarations_According_To_Modes (Pointed_Node, In_Modes); return Pointed_Node; end Find_Subprogram_Call; ------------------ -- Select_Nodes -- ------------------ procedure Select_Nodes (Decl_List : List_Id; Kinds : Node_Kind_Array; First_Node : in out Node_Id; Last_Node : in out Node_Id) is Success : Boolean; Local_List_Node : Node_Id; begin if not Is_Empty (Decl_List) then Local_List_Node := Ocarina.Nodes.First_Node (Decl_List); while Present (Local_List_Node) loop Success := False; for K in Kinds'Range loop Success := Success or else (Kind (Local_List_Node) = Kinds (K)); end loop; if Success then if No (First_Node) then First_Node := Local_List_Node; Last_Node := Local_List_Node; else Set_Next_Entity (Last_Node, Local_List_Node); Set_Next_Entity (Local_List_Node, No_Node); Last_Node := Local_List_Node; end if; end if; Local_List_Node := Next_Node (Local_List_Node); end loop; end if; end Select_Nodes; end Ocarina.Analyzer.Finder;