------------------------------------------- ------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A N A L Y Z E R . L I N K S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2006-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 Utils; use Utils; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Analyzer.Finder; with Ocarina.Analyzer.Messages; with Ocarina.Analyzer.Naming_Rules; with Ocarina.Entities.Components; with Ocarina.Entities.Components.Flows; with Ocarina.Entities.Properties; package body Ocarina.Analyzer.Links is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Analyzer.Finder; use Ocarina.Analyzer.Messages; use Ocarina.Analyzer.Naming_Rules; use Ocarina.Entities; use Ocarina.Entities.Components; use Ocarina.Entities.Components.Flows; use Ocarina.Entities.Properties; function Link_Declarations_Of_Package (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the -- declarations of an AADL package. function Link_Declarations_Of_Property_Set (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the -- declarations of an AADL property set. function Link_Component_Implementation_Subclauses (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the -- subclauses (call sequences, subcomponents...) of a component -- implementation. function Link_Component_Type_Subclauses (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the -- subclauses (featues...) of a component type. function Link_Port_Group_Type_Subclauses (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the -- subclauses (featues...) of a port group. function Link_Property_Associations_Of_Component_Type (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the property -- associations of a component type. function Link_Property_Associations_Of_Component_Implementation (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the property -- associations of a component implementation. function Link_Property_Associations_Of_Port_Group_Type (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the property -- associations of a port group. function Link_Property_Value (Root : Node_Id; Container : Node_Id; Node : Node_Id; Property_Type : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the property -- value 'Node'. function Link_Type_Designator (Root : Node_Id; Designator : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform the designator and identifier link of a property type. function Link_Property_Associations_Of_Package (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean; -- Perform all the designator and identifier links in the property -- associations of an AADL package. procedure Retrieve_Connection_End (Component : Node_Id; Connection_End : Node_Id; Corresponding_Node : out Node_Id; Is_Local : out Boolean); -- Find the node corresponding to the end of a connection function Find_Port_Spec (Port_Identifier : Node_Id; Component : Node_Id) return Node_Id; -- Return the port instance having the identifier -- 'Port_Identifier' in the component 'Component'. function Find_Flow_Of_Subcomponent (Flow_Identifier : Node_Id; Component : Node_Id; In_Modes : Node_Id := No_Node) return Node_Id; -- Return the flow instance having the identifier -- 'Flow_Identifier' in the compoenent 'Component' in the modes -- 'In_Modes'. function Equals (Unit_Id_1 : Node_Id; Unit_Id_2 : Node_Id) return Boolean; -- Return True when the two identifiers have the same name. This -- function is *not* case sensitive. function Unwind_Units_Type (Property_Type : Node_Id) return Node_Id; -- Return the units type declaration corresponding to the given -- property type. If the type definition does not contain any unit -- definition, then return No_Bode. ------------ -- Equals -- ------------ function Equals (Unit_Id_1 : Node_Id; Unit_Id_2 : Node_Id) return Boolean is begin return To_Lower (Name (Unit_Id_1)) = To_Lower (Name (Unit_Id_2)); end Equals; ------------------------------- -- Find_Flow_Of_Subcomponent -- ------------------------------- function Find_Flow_Of_Subcomponent (Flow_Identifier : Node_Id; Component : Node_Id; In_Modes : Node_Id := No_Node) return Node_Id is pragma Assert (Kind (Flow_Identifier) = K_Entity_Reference); pragma Assert (Kind (Component) = K_Component_Implementation or else Kind (Component) = K_Component_Type); Pointed_Node : Node_Id; Pointed_Component : Node_Id; begin Pointed_Node := Find_Subcomponent (Component => Component, Subcomponent_Identifier => Item (First_Node (Path (Flow_Identifier))), In_Modes => In_Modes); if Present (Pointed_Node) and then Present (Next_Node (First_Node (Path (Flow_Identifier)))) then Pointed_Component := Get_Referenced_Entity (Entity_Ref (Pointed_Node)); Pointed_Node := Find_Flow_Spec (Component => Pointed_Component, Flow_Identifier => Item (Next_Node (First_Node (Path (Flow_Identifier))))); end if; if No (Pointed_Node) or else Kind (Pointed_Node) /= K_Flow_Spec then return No_Node; else return Pointed_Node; end if; end Find_Flow_Of_Subcomponent; -------------------- -- Find_Port_Spec -- -------------------- function Find_Port_Spec (Port_Identifier : Node_Id; Component : Node_Id) return Node_Id is pragma Assert (Kind (Port_Identifier) = K_Entity_Reference); pragma Assert (Kind (Component) = K_Component_Implementation or else Kind (Component) = K_Component_Type); Pointed_Node : Node_Id; Pointed_Port_Group : Node_Id; begin Pointed_Node := Find_Feature (Component => Component, Feature_Identifier => Item (First_Node (Path (Port_Identifier)))); if Next_Node (First_Node (Path (Port_Identifier))) /= No_Node then Pointed_Port_Group := Get_Referenced_Entity (Entity_Ref (Pointed_Node)); Pointed_Node := Find_Feature (Component => Pointed_Port_Group, Feature_Identifier => Item (Next_Node (First_Node (Path (Port_Identifier))))); end if; if No (Pointed_Node) or else (Kind (Pointed_Node) /= K_Port_Spec and then Kind (Pointed_Node) /= K_Port_Group_Spec and then Kind (Pointed_Node) /= K_Parameter) then return No_Node; else return Pointed_Node; end if; end Find_Port_Spec; --------------- -- Link_Call -- --------------- function Link_Call (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Subprogram_Call); pragma Assert (Kind (Entity_Ref (Node)) = K_Entity_Reference); Success : Boolean := True; Pointed_Node : Node_Id := No_Node; Other_Pointed_Node : Node_Id := No_Node; Subprogram_Ref : constant Node_Id := Entity_Ref (Node); Pack_Identifier : constant Node_Id := Namespace_Identifier (Subprogram_Ref); Pointed_Node_Is_Ok : Boolean; Other_Pointed_Node_Is_Ok : Boolean; begin Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Pack_Identifier, Component_Identifier => Identifier (Subprogram_Ref), Options => Options); if Present (Next_Node (First_Node (Path (Subprogram_Ref)))) then Other_Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Pack_Identifier, Component_Identifier => Item (First_Node (Path (Subprogram_Ref))), Options => Options); if Present (Other_Pointed_Node) and then Kind (Other_Pointed_Node) = K_Component_Type and then (Component_Category'Val (Category (Other_Pointed_Node)) = CC_Thread or else Component_Category'Val (Category (Other_Pointed_Node)) = CC_Data) then -- Link the Identifier to its corresponding component Set_Corresponding_Entity (Item (First_Node (Path (Subprogram_Ref))), Other_Pointed_Node); Other_Pointed_Node := Find_Feature (Component => Other_Pointed_Node, Feature_Identifier => Item (Next_Node (First_Node (Path (Subprogram_Ref))))); else Other_Pointed_Node := No_Node; end if; end if; Pointed_Node_Is_Ok := Present (Pointed_Node) and then ((Kind (Pointed_Node) = K_Component_Type or else Kind (Pointed_Node) = K_Component_Implementation) and then Component_Category'Val (Category (Pointed_Node)) = CC_Subprogram); Other_Pointed_Node_Is_Ok := Present (Other_Pointed_Node) and then Kind (Other_Pointed_Node) = K_Subprogram_Spec; if Pointed_Node_Is_Ok and then Other_Pointed_Node_Is_Ok then DAE (Node1 => Node, Message1 => " points to ", Node2 => Pointed_Node); DAE (Node1 => Node, Message1 => " also points to ", Node2 => Other_Pointed_Node); Success := False; elsif Pointed_Node_Is_Ok then Set_Referenced_Entity (Entity_Ref (Node), Pointed_Node); elsif Other_Pointed_Node_Is_Ok then -- In this case, the Other_Pointed_Node is a subprogram -- spec, we must link it now because the data component the -- subprogram spec may be declared at the end of the AADL -- specification. Success := Link_Feature (Root, Other_Pointed_Node, Options) and then Success; Set_Referenced_Entity (Entity_Ref (Node), Other_Pointed_Node); else DLTWN (Node, Pointed_Node); Success := False; end if; return Success; end Link_Call; ---------------------------------------------- -- Link_Component_Implementation_Subclauses -- ---------------------------------------------- function Link_Component_Implementation_Subclauses (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Component_Implementation); List_Node : Node_Id; Call_List_Node : Node_Id; Success : Boolean := True; Subclause_Success : Boolean := True; begin -- modes, connections and flows are linked only if -- subcomponents and features were correctly linked. Indeed, -- those subclauses may access elements pointed by -- subcomponents or features. if not Is_Empty (Ocarina.Nodes.Refines_Type (Node)) then List_Node := First_Node (Ocarina.Nodes.Refines_Type (Node)); while Present (List_Node) loop Success := Link_Feature (Root, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Subcomponents (Node)) then List_Node := First_Node (Ocarina.Nodes.Subcomponents (Node)); while Present (List_Node) loop Success := Link_Subcomponent (Root, List_Node, Options) and then Link_In_Modes_Statement (Node, In_Modes (List_Node)) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Calls (Node)) then List_Node := First_Node (Ocarina.Nodes.Calls (Node)); while Present (List_Node) loop Success := Link_In_Modes_Statement (Node, In_Modes (List_Node)) and then Success; if not Is_Empty (Subprogram_Calls (List_Node)) then Call_List_Node := First_Node (Subprogram_Calls (List_Node)); while Present (Call_List_Node) loop Success := Link_Call (Root, Call_List_Node, Options) and then Success; Call_List_Node := Next_Node (Call_List_Node); end loop; end if; List_Node := Next_Node (List_Node); end loop; end if; Subclause_Success := Success; if Subclause_Success and then not Is_Empty (Ocarina.Nodes.Connections (Node)) then List_Node := First_Node (Ocarina.Nodes.Connections (Node)); while Present (List_Node) loop Success := Link_Connection (Node, List_Node) and then Link_In_Modes_Statement (Node, In_Modes (List_Node)) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if Subclause_Success and then not Is_Empty (Ocarina.Nodes.Flows (Node)) then List_Node := First_Node (Ocarina.Nodes.Flows (Node)); while Present (List_Node) loop if Kind (List_Node) = K_End_To_End_Flow_Refinement or else Kind (List_Node) = K_End_To_End_Flow_Spec then Success := Link_End_To_End_Flow_Spec (Node, List_Node) and then Link_In_Modes_Statement (Node, In_Modes (List_Node)) and then Success; elsif Kind (List_Node) = K_Flow_Implementation_Refinement or else Kind (List_Node) = K_Flow_Implementation then Success := Link_Flow_Implementation (Node, List_Node) and then Link_In_Modes_Statement (Node, In_Modes (List_Node)) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; if Subclause_Success and then not Is_Empty (Ocarina.Nodes.Modes (Node)) then List_Node := First_Node (Ocarina.Nodes.Modes (Node)); while Present (List_Node) loop if Kind (List_Node) = K_Mode_Transition then Success := Link_Mode_Transition (Node, List_Node) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Link_Component_Implementation_Subclauses; ----------------------------------------------------- -- Link_Component_Implementation_To_Component_Type -- ----------------------------------------------------- function Link_Component_Implementation_To_Component_Type (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Component_Implementation); Success : Boolean := True; Pointed_Node : Node_Id; begin Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => No_Node, Component_Identifier => Component_Type_Identifier (Node), Options => Options); -- According to the AADL syntax, the component type must in the -- same namespace as the implementations. if No (Pointed_Node) then DAE (Node1 => Node, Message1 => " implements a component type that does not exist"); Success := False; elsif Kind (Pointed_Node) /= K_Component_Type then DAE (Node1 => Node, Message1 => " implements ", Node2 => Pointed_Node, Message2 => ", which is not a component type"); Success := False; elsif Category (Pointed_Node) /= Category (Node) then DAE (Node1 => Node, Message1 => " implements ", Node2 => Pointed_Node, Message2 => ", which is of different kind"); Success := False; else Set_Corresponding_Entity (Component_Type_Identifier (Node), Pointed_Node); Success := True; end if; return Success; end Link_Component_Implementation_To_Component_Type; -------------------------------------------- -- Link_Component_Or_Port_Group_Extension -- -------------------------------------------- function Link_Component_Or_Port_Group_Extension (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Component_Implementation or else Kind (Node) = K_Component_Type or else Kind (Node) = K_Port_Group_Type); Success : Boolean := True; Pointed_Node : Node_Id; begin if Present (Parent (Node)) then declare Component_Ref : constant Node_Id := Parent (Node); Pack_Identifier : Node_Id; begin Pack_Identifier := Namespace_Identifier (Component_Ref); if Kind (Node) = K_Port_Group_Type then Pointed_Node := Find_Port_Group_Classifier (Root => Root, Package_Identifier => Pack_Identifier, Port_Group_Identifier => Identifier (Component_Ref), Options => Options); else Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Pack_Identifier, Component_Identifier => Identifier (Component_Ref), Options => Options); end if; end; if No (Pointed_Node) then DAE (Node1 => Node, Message1 => " extends something that does not exist"); Success := False; elsif Kind (Pointed_Node) /= Kind (Node) then DAE (Node1 => Node, Message1 => " extends ", Node2 => Pointed_Node, Message2 => ", which is not of the same kind"); Success := False; elsif Kind (Node) /= K_Port_Group_Type and then Category (Pointed_Node) /= Category (Node) then DAE (Node1 => Node, Message1 => " extends ", Node2 => Pointed_Node, Message2 => ", which is of different type"); Success := False; else Set_Referenced_Entity (Parent (Node), Pointed_Node); Success := True; end if; end if; return Success; end Link_Component_Or_Port_Group_Extension; ------------------------------------ -- Link_Component_Type_Subclauses -- ------------------------------------ function Link_Component_Type_Subclauses (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Component_Type); List_Node : Node_Id; Success : Boolean := True; begin if not Is_Empty (Features (Node)) then List_Node := First_Node (Features (Node)); while Present (List_Node) loop Success := Link_Feature (Root, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Flows (Node)) then List_Node := First_Node (Ocarina.Nodes.Flows (Node)); while Present (List_Node) loop Success := Link_Flow_Spec (Node, List_Node) and then Success; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Link_Component_Type_Subclauses; --------------------- -- Link_Connection -- --------------------- function Link_Connection (Component : Node_Id; Node : Node_Id) return Boolean is Success : Boolean := True; Source_Node : Node_Id; Destination_Node : Node_Id; Source_Is_Local : Boolean; Destination_Is_Local : Boolean; begin if Is_Refinement (Node) then return True; end if; pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Node) = K_Connection); pragma Assert (Kind (Source (Node)) = K_Entity_Reference); pragma Assert (Kind (Destination (Node)) = K_Entity_Reference); -- Connection source Retrieve_Connection_End (Component => Component, Connection_End => Source (Node), Corresponding_Node => Source_Node, Is_Local => Source_Is_Local); if No (Source_Node) then DAE (Node1 => Source (Node), Message1 => "does not point to anything"); Success := False; end if; -- Connection destination Retrieve_Connection_End (Component => Component, Connection_End => Destination (Node), Corresponding_Node => Destination_Node, Is_Local => Destination_Is_Local); if No (Destination_Node) then DAE (Node1 => Destination (Node), Message1 => "does not point to anything"); Success := False; end if; if Success then Set_Referenced_Entity (Source (Node), Source_Node); Display_Node_Link (Identifier (Source (Node)), Source_Node); Set_Referenced_Entity (Destination (Node), Destination_Node); Display_Node_Link (Identifier (Destination (Node)), Destination_Node); end if; return Success; end Link_Connection; ------------------------------------- -- Link_Declarations_Of_Namespaces -- ------------------------------------- function Link_Declarations_Of_Namespaces (Root : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Entity_Scope (Root)); if not Is_Empty (Declarations (Root)) then List_Node := First_Node (Declarations (Root)); while Present (List_Node) loop if Kind (List_Node) = K_Package_Specification then Success := Link_Declarations_Of_Package (Root => Root, Node => List_Node, Options => Options) and then Success; elsif Kind (List_Node) = K_Property_Set then Success := Link_Declarations_Of_Property_Set (Root => Root, Node => List_Node, Options => Options) and then Success; elsif Kind (List_Node) = K_Component_Type or else Kind (List_Node) = K_Component_Implementation or else Kind (List_Node) = K_Port_Group_Type then Success := Link_Component_Or_Port_Group_Extension (Root => Root, Node => List_Node, Options => Options) and then Success; end if; if Kind (List_Node) = K_Component_Implementation then Success := Link_Component_Implementation_To_Component_Type (Root, List_Node, Options) and then Success; end if; if Kind (List_Node) = K_Port_Group_Type then Success := Link_Inverse_Of_Port_Group_Type (Root, List_Node, Options) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Declarations_Of_Namespaces; ---------------------------------- -- Link_Declarations_Of_Package -- ---------------------------------- function Link_Declarations_Of_Package (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Package_Specification); List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Entity_Scope (Node)); if not Is_Empty (Declarations (Node)) then List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop if Kind (List_Node) = K_Component_Type or else Kind (List_Node) = K_Component_Implementation or else Kind (List_Node) = K_Port_Group_Type then Success := Link_Component_Or_Port_Group_Extension (Root, List_Node, Options) and then Success; end if; if Kind (List_Node) = K_Component_Implementation then Success := Link_Component_Implementation_To_Component_Type (Root, List_Node, Options) and then Success; end if; if Kind (List_Node) = K_Port_Group_Type then Success := Link_Inverse_Of_Port_Group_Type (Root, List_Node, Options) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Declarations_Of_Package; --------------------------------------- -- Link_Declarations_Of_Property_Set -- --------------------------------------- function Link_Declarations_Of_Property_Set (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Property_Set); List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Entity_Scope (Node)); if not Is_Empty (Declarations (Node)) then List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop case Kind (List_Node) is when K_Property_Name_Declaration => Success := Link_Property_Name (Root, List_Node, Options) and then Success; when K_Property_Type_Declaration => Success := Link_Property_Type (Root, List_Node, Options) and then Success; when K_Constant_Property_Declaration => Success := Link_Property_Constant (Root, List_Node, Options) and then Success; when others => raise Program_Error; end case; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Declarations_Of_Property_Set; ------------------------------- -- Link_End_To_End_Flow_Spec -- ------------------------------- function Link_End_To_End_Flow_Spec (Component : Node_Id; Flow : Node_Id) return Boolean is pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Flow) = K_End_To_End_Flow_Refinement or else Kind (Flow) = K_End_To_End_Flow_Spec); Success : Boolean := True; Inadequate_Pointed_Node : Boolean; Pointed_Node : Node_Id; List_Node : Node_Id; begin if Kind (Flow) = K_End_To_End_Flow_Spec then if not Is_Empty (Connections (Flow)) then List_Node := First_Node (Connections (Flow)); while Present (List_Node) loop pragma Assert (Kind (List_Node) = K_Entity_Reference); Inadequate_Pointed_Node := False; -- This will be set to True if we find a node that -- does not fit if List_Node = First_Node (Connections (Flow)) then Pointed_Node := Find_Flow_Of_Subcomponent (Component => Component, Flow_Identifier => List_Node); if Present (Pointed_Node) and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Source and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path then DAE (Node1 => List_Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => " which should be a flow source " & "or flow path"); Inadequate_Pointed_Node := True; end if; elsif List_Node = Last_Node (Connections (Flow)) then Pointed_Node := Find_Flow_Of_Subcomponent (Component => Component, Flow_Identifier => List_Node, In_Modes => In_Modes (Flow)); if Present (Pointed_Node) and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Sink and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path then DAE (Node1 => List_Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => " which should be a flow sink " & "or flow path"); Inadequate_Pointed_Node := True; end if; else if Next_Node (First_Node (Path (List_Node))) = No_Node then Pointed_Node := Find_Connection (Connection_Identifier => Item (First_Node (Path (List_Node))), Component => Component, In_Modes => In_Modes (Flow)); else Pointed_Node := Find_Flow_Of_Subcomponent (Flow_Identifier => List_Node, Component => Component, In_Modes => In_Modes (Flow)); if Present (Pointed_Node) and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path then DAE (Node1 => List_Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => " which should be a flow path"); Inadequate_Pointed_Node := True; end if; end if; end if; if not Inadequate_Pointed_Node then if No (Pointed_Node) then DLTWN (List_Node, Pointed_Node); Success := False; else if Next_Node (First_Node (Path (List_Node))) = No_Node then Set_Corresponding_Entity (Item (First_Node (Path (List_Node))), Pointed_Node); else Set_Corresponding_Entity (Item (Next_Node (First_Node (Path (List_Node)))), Pointed_Node); end if; end if; else Success := False; Pointed_Node := No_Node; end if; Display_Node_Link (List_Node, Pointed_Node); List_Node := Next_Node (List_Node); end loop; end if; end if; return Success; end Link_End_To_End_Flow_Spec; ------------------ -- Link_Feature -- ------------------ function Link_Feature (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Port_Spec or else Kind (Node) = K_Parameter or else Kind (Node) = K_Port_Group_Spec or else Kind (Node) = K_Subprogram_Spec or else Kind (Node) = K_Subcomponent_Access); Success : Boolean := True; Pointed_Node : Node_Id := No_Node; Other_Pointed_Node : Node_Id := No_Node; No_Ref_Given : Boolean := False; -- Some features may not refere to components (e.g. data ports) begin case Kind (Node) is when K_Port_Spec | K_Parameter => if Kind (Node) = K_Parameter or else Is_Data (Node) then declare Component_Ref : constant Node_Id := Entity_Ref (Node); begin if Present (Component_Ref) then Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Component_Ref), Component_Identifier => Identifier (Component_Ref), Options => Options); else Pointed_Node := No_Node; No_Ref_Given := True; end if; if No (Pointed_Node) then if No_Ref_Given then Success := True; else DLTWN (Node, Pointed_Node); Success := False; end if; elsif not ((Kind (Pointed_Node) = K_Component_Type or else Kind (Pointed_Node) = K_Component_Implementation) and then Component_Category'Val (Category (Pointed_Node)) = CC_Data) then DLTWN (Node, Pointed_Node); Success := False; else Set_Referenced_Entity (Component_Ref, Pointed_Node); Success := True; end if; end; else -- If we are dealing with an event port No_Ref_Given := True; Success := True; end if; when K_Port_Group_Spec => declare Port_Group_Ref : constant Node_Id := Entity_Ref (Node); begin if Present (Port_Group_Ref) then Pointed_Node := Find_Port_Group_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Port_Group_Ref), Port_Group_Identifier => Identifier (Port_Group_Ref), Options => Options); else Pointed_Node := No_Node; No_Ref_Given := True; end if; if No (Pointed_Node) then if No_Ref_Given then Success := True; else DLTWN (Node, Pointed_Node); Success := False; end if; elsif Kind (Pointed_Node) /= K_Port_Group_Type then DLTWN (Node, Pointed_Node); Success := False; else Set_Referenced_Entity (Port_Group_Ref, Pointed_Node); Success := True; end if; end; when K_Subprogram_Spec => declare Subprog_Ref : constant Node_Id := Entity_Ref (Node); begin if Present (Subprog_Ref) then Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Subprog_Ref), Component_Identifier => Identifier (Subprog_Ref), Options => Options); Other_Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Subprog_Ref), Component_Identifier => Item (First_Node (Path (Subprog_Ref))), Options => Options); if Present (Other_Pointed_Node) and then Kind (Other_Pointed_Node) = K_Component_Type and then Next_Node (First_Node (Path (Subprog_Ref))) /= No_Node then Other_Pointed_Node := Find_Feature (Component => Other_Pointed_Node, Feature_Identifier => Item (Next_Node (First_Node (Path (Subprog_Ref))))); else Other_Pointed_Node := No_Node; end if; else Pointed_Node := No_Node; No_Ref_Given := True; end if; if Present (Pointed_Node) and then Present (Other_Pointed_Node) then DAE (Node1 => Node, Message1 => " points to ", Node2 => Pointed_Node); DAE (Node1 => Node, Message1 => " also points to ", Node2 => Other_Pointed_Node); Success := False; else if No (Pointed_Node) then Pointed_Node := Other_Pointed_Node; end if; if No (Pointed_Node) then if No_Ref_Given then Success := True; -- Nothing was to be found. It is OK else DLTWN (Node, Pointed_Node); Success := False; end if; elsif not (((Kind (Pointed_Node) = K_Component_Type or else Kind (Pointed_Node) = K_Component_Implementation) and then Component_Category'Val (Category (Pointed_Node)) = CC_Subprogram) or else (Kind (Pointed_Node) = K_Subprogram_Spec and then not Is_Server (Pointed_Node))) then DLTWN (Node, Pointed_Node); Success := False; else Set_Referenced_Entity (Subprog_Ref, Pointed_Node); Success := True; end if; end if; end; when K_Subcomponent_Access => declare Subcomp_Ref : constant Node_Id := Entity_Ref (Node); begin if Present (Subcomp_Ref) then Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Subcomp_Ref), Component_Identifier => Identifier (Subcomp_Ref), Options => Options); else Pointed_Node := No_Node; No_Ref_Given := True; end if; if No (Pointed_Node) then if No_Ref_Given then Success := True; else DLTWN (Node, Pointed_Node); Success := False; end if; elsif not ((Kind (Pointed_Node) = K_Component_Type or else Kind (Pointed_Node) = K_Component_Implementation) and then Category (Pointed_Node) = Subcomponent_Category (Node)) then DLTWN (Node, Pointed_Node); Success := False; else Set_Referenced_Entity (Subcomp_Ref, Pointed_Node); Success := True; end if; end; when others => raise Program_Error; end case; if not No_Ref_Given then Display_Node_Link (Node, Pointed_Node); end if; return Success; end Link_Feature; ------------------------------ -- Link_Flow_Implementation -- ------------------------------ function Link_Flow_Implementation (Component : Node_Id; Flow : Node_Id) return Boolean is pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Flow) = K_Flow_Implementation_Refinement or else Kind (Flow) = K_Flow_Implementation); Success : Boolean := True; Inadequate_Pointed_Node : Boolean; Pointed_Node : Node_Id; List_Node : Node_Id; begin if Kind (Flow) = K_Flow_Implementation then if not Is_Empty (Connections (Flow)) then List_Node := First_Node (Connections (Flow)); while Present (List_Node) loop pragma Assert (Kind (List_Node) = K_Entity_Reference); Inadequate_Pointed_Node := False; -- This will be set to True if we find a node that -- does not fit. if List_Node = First_Node (Connections (Flow)) then case Flow_Category'Val (Category (Flow)) is when FC_Path | FC_Sink => Pointed_Node := Find_Port_Spec (Component => Component, Port_Identifier => List_Node); when FC_Source => Pointed_Node := Find_Flow_Of_Subcomponent (Component => Component, Flow_Identifier => List_Node); if Present (Pointed_Node) and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Source then DAE (Node1 => List_Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => " which should be a flow source"); Inadequate_Pointed_Node := True; end if; end case; elsif List_Node = Last_Node (Connections (Flow)) then case Flow_Category'Val (Category (Flow)) is when FC_Path | FC_Source => Pointed_Node := Find_Port_Spec (Component => Component, Port_Identifier => List_Node); when FC_Sink => Pointed_Node := Find_Flow_Of_Subcomponent (Component => Component, Flow_Identifier => List_Node, In_Modes => In_Modes (Flow)); if Present (Pointed_Node) and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Sink then DAE (Node1 => List_Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => " which should be a flow sink"); Inadequate_Pointed_Node := True; end if; end case; else if Next_Node (First_Node (Path (List_Node))) = No_Node then Pointed_Node := Find_Connection (Connection_Identifier => Item (First_Node (Path (List_Node))), Component => Component, In_Modes => In_Modes (Flow)); else Pointed_Node := Find_Flow_Of_Subcomponent (Flow_Identifier => List_Node, Component => Component, In_Modes => In_Modes (Flow)); if Present (Pointed_Node) and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path then DAE (Node1 => List_Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => " which should be a flow path"); Inadequate_Pointed_Node := True; end if; end if; end if; if not Inadequate_Pointed_Node then if No (Pointed_Node) then DLTWN (List_Node, Pointed_Node); Success := False; else if Next_Node (First_Node (Path (List_Node))) = No_Node then Set_Corresponding_Entity (Item (First_Node (Path (List_Node))), Pointed_Node); else Set_Corresponding_Entity (Item (Next_Node (First_Node (Path (List_Node)))), Pointed_Node); end if; end if; else Pointed_Node := No_Node; Success := False; end if; Display_Node_Link (List_Node, Pointed_Node); List_Node := Next_Node (List_Node); end loop; end if; end if; return Success; end Link_Flow_Implementation; -------------------- -- Link_Flow_Spec -- -------------------- function Link_Flow_Spec (Component : Node_Id; Flow : Node_Id) return Boolean is pragma Assert (Kind (Component) = K_Component_Type); pragma Assert (Kind (Flow) = K_Flow_Spec); Success : Boolean := True; Pointed_Node : Node_Id := No_Node; begin -- Flow refinements do not contain elements to link. The -- semantic part of the analyzer should check if a flow -- refinement corresponds to an existing flow -- implementation. It should also check that the different -- elements of the flow are compatible (e.g. connections -- actually connect the flows and ports specified). if Is_Refinement (Flow) then return True; end if; if Flow_Category'Val (Category (Flow)) = FC_Source or else Flow_Category'Val (Category (Flow)) = FC_Path then Pointed_Node := Find_Port_Spec (Port_Identifier => Source_Flow (Flow), Component => Component); if No (Pointed_Node) then DLTWN (Source_Flow (Flow), Pointed_Node); Success := False; else if Next_Node (First_Node (Path (Source_Flow (Flow)))) = No_Node then Display_Node_Link (Item (First_Node (Path (Source_Flow (Flow)))), Pointed_Node); Set_Corresponding_Entity (Item (First_Node (Path (Source_Flow (Flow)))), Pointed_Node); else Display_Node_Link (Item (Next_Node (First_Node (Path (Source_Flow (Flow))))), Pointed_Node); Set_Corresponding_Entity (Item (Next_Node (First_Node (Path (Source_Flow (Flow))))), Pointed_Node); end if; end if; end if; if Flow_Category'Val (Category (Flow)) = FC_Sink or else Flow_Category'Val (Category (Flow)) = FC_Path then Pointed_Node := Find_Port_Spec (Port_Identifier => Sink_Flow (Flow), Component => Component); if No (Pointed_Node) then DLTWN (Sink_Flow (Flow), Pointed_Node); Success := False; else if Next_Node (First_Node (Path (Sink_Flow (Flow)))) = No_Node then Display_Node_Link (Item (First_Node (Path (Sink_Flow (Flow)))), Pointed_Node); Set_Corresponding_Entity (Item (First_Node (Path (Sink_Flow (Flow)))), Pointed_Node); else Display_Node_Link (Item (Next_Node (First_Node (Path (Sink_Flow (Flow))))), Pointed_Node); Set_Corresponding_Entity (Item (Next_Node (First_Node (Path (Sink_Flow (Flow))))), Pointed_Node); end if; end if; end if; return Success; end Link_Flow_Spec; ----------------------------- -- Link_In_Modes_Statement -- ----------------------------- function Link_In_Modes_Statement (Component : Node_Id; In_Modes : Node_Id) return Boolean is pragma Assert (Kind (Component) = K_Component_Implementation); function Set_Corresponding_Mode (Component : Node_Id; Mode_Reference : Node_Id) return Boolean; ---------------------------- -- Set_Corresponding_Mode -- ---------------------------- function Set_Corresponding_Mode (Component : Node_Id; Mode_Reference : Node_Id) return Boolean is Pointed_Node : Node_Id; Success : Boolean := True; begin Pointed_Node := Find_Mode (Component, Identifier (Mode_Reference)); if No (Pointed_Node) or else Kind (Pointed_Node) /= K_Mode then DLTWN (Mode_Reference, Pointed_Node); Success := False; else Set_Referenced_Entity (Mode_Reference, Pointed_Node); end if; return Success; end Set_Corresponding_Mode; List_Node : Node_Id; Success : Boolean := True; begin if Present (In_Modes) then List_Node := First_Node (Ocarina.Nodes.Modes (In_Modes)); while Present (List_Node) loop if Kind (List_Node) = K_Entity_Reference then Success := Set_Corresponding_Mode (Component, List_Node) and then Success; elsif Kind (List_Node) = K_Pair_Of_Entity_References then Success := Set_Corresponding_Mode (Component, First_Reference (List_Node)) and then Set_Corresponding_Mode (Component, Second_Reference (List_Node)) and then Success; else raise Program_Error; end if; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Link_In_Modes_Statement; ------------------------------------- -- Link_Inverse_Of_Port_Group_Type -- ------------------------------------- function Link_Inverse_Of_Port_Group_Type (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is Success : Boolean := True; Pointed_Node : Node_Id := No_Node; begin if Present (Inverse_Of (Node)) then Pointed_Node := Find_Port_Group_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Inverse_Of (Node)), Port_Group_Identifier => Identifier (Inverse_Of (Node)), Options => Options); if No (Pointed_Node) or else Kind (Pointed_Node) /= K_Port_Group_Type then DLTWN (Node, Pointed_Node); Success := False; else Set_Referenced_Entity (Inverse_Of (Node), Pointed_Node); end if; end if; return Success; end Link_Inverse_Of_Port_Group_Type; -------------------------- -- Link_Mode_Transition -- -------------------------- function Link_Mode_Transition (Component : Node_Id; Node : Node_Id) return Boolean is pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Node) = K_Mode_Transition); Source_Mode_List : constant List_Id := Source_Modes (Node); Port_List : constant List_Id := Unique_Ports (Node); Destination_Mode : constant Node_Id := Ocarina.Nodes.Destination_Mode (Node); List_Node : Node_Id; Pointed_Node : Node_Id; SC_Owned : Boolean; Success : Boolean := True; begin -- We first link with the in event ports if not Is_Empty (Port_List) then List_Node := First_Node (Port_List); while Present (List_Node) loop if No (Next_Node (First_Node (Path (List_Node)))) then -- We look for a feature of the component Pointed_Node := Find_Feature (Component => Component, Feature_Identifier => Item (First_Node (Path (List_Node)))); SC_Owned := False; else -- We look for a feature of a subcomponent Pointed_Node := Find_Subcomponent (Component => Component, Subcomponent_Identifier => Item (First_Node (Path (List_Node)))); if Present (Pointed_Node) and then Get_Referenced_Entity (Entity_Ref (Pointed_Node)) /= No_Node then Pointed_Node := Find_Feature (Component => Get_Referenced_Entity (Entity_Ref (Pointed_Node)), Feature_Identifier => Item (Next_Node (First_Node (Path (List_Node))))); SC_Owned := True; end if; end if; if Present (Pointed_Node) then if Kind (Pointed_Node) /= K_Port_Spec or else not Is_Event (Pointed_Node) or else Is_Data (Pointed_Node) then -- Mode triggers must be pure event ports DAE (Node1 => List_Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => ", which is not an event port"); Success := False; elsif SC_Owned and then not Is_Out (Pointed_Node) then -- Mode triggers belonging to a subcomponent must -- be OUT or IN OUT. DAE (Node1 => List_Node, Message1 => " points to subcomponent port ", Node2 => Pointed_Node, Message2 => ", which is not an OUT nor INOUT event port"); Success := False; elsif not SC_Owned and then not Is_In (Pointed_Node) then -- Mode triggers belonging to the current component -- must be IN or IN OUT. DAE (Node1 => List_Node, Message1 => " points to port ", Node2 => Pointed_Node, Message2 => ", which is not an IN nor INOUT event port"); Success := False; else -- Every thing is fine Set_Corresponding_Entity (Item (First_Node (Path (List_Node))), Pointed_Node); end if; else DLTWN (List_Node, Pointed_Node); Success := False; end if; List_Node := Next_Node (List_Node); end loop; else DAE (Message0 => "Mode transition ", Node1 => Node, Message1 => " depends on no in event port"); Success := False; end if; -- Then we link the source modes with the modes declared within -- the component implementation. if not Is_Empty (Source_Mode_List) then List_Node := First_Node (Source_Mode_List); while Present (List_Node) loop Pointed_Node := Find_Mode (Component => Component, Mode_Identifier => List_Node); if Present (Pointed_Node) then Set_Corresponding_Entity (List_Node, Pointed_Node); else DLTWN (List_Node, Pointed_Node); Success := False; end if; List_Node := Next_Node (List_Node); end loop; else DAE (Message0 => "warning: ", Node1 => Node, Message1 => " has no source mode"); end if; -- Finally we link the destination mode Pointed_Node := Find_Mode (Component => Component, Mode_Identifier => Destination_Mode); if Present (Pointed_Node) then Set_Corresponding_Entity (Destination_Mode, Pointed_Node); else DLTWN (Destination_Mode, Pointed_Node); Success := False; end if; return Success; end Link_Mode_Transition; ------------------------------------- -- Link_Port_Group_Type_Subclauses -- ------------------------------------- function Link_Port_Group_Type_Subclauses (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Port_Group_Type); List_Node : Node_Id; Success : Boolean := True; begin if not Is_Empty (Ocarina.Nodes.Features (Node)) then List_Node := First_Node (Ocarina.Nodes.Features (Node)); while Present (List_Node) loop Success := Link_Feature (Root, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Link_Port_Group_Type_Subclauses; ------------------------------- -- Link_Property_Association -- ------------------------------- function Link_Property_Association (Root : Node_Id; Container : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Property_Association); pragma Assert (Kind (Container) = K_Component_Implementation or else Kind (Container) = K_Component_Type or else Kind (Container) = K_Port_Group_Type or else Kind (Container) = K_Package_Specification or else Kind (Container) = K_Flow_Spec or else Kind (Container) = K_Flow_Implementation or else Kind (Container) = K_Flow_Implementation_Refinement or else Kind (Container) = K_End_To_End_Flow_Spec or else Kind (Container) = K_End_To_End_Flow_Refinement or else Kind (Container) = K_Connection or else Kind (Container) = K_Subcomponent or else Kind (Container) = K_Port_Spec or else Kind (Container) = K_Parameter or else Kind (Container) = K_Port_Group_Spec or else Kind (Container) = K_Subcomponent_Access or else Kind (Container) = K_Subprogram_Spec or else Kind (Container) = K_Mode or else Kind (Container) = K_Subprogram_Call); Success : Boolean := True; Pointed_Node : Node_Id; Corresponding_Container : Node_Id; List_Node : Node_Id; Property_Type : Node_Id := No_Node; begin Pointed_Node := Find_Property_Entity (Root => Root, Property_Set_Identifier => Namespace_Identifier (Property_Name (Node)), Property_Identifier => Identifier (Property_Name (Node)), Options => Options); if No (Pointed_Node) then DAE (Node1 => Node, Message1 => "does not point to anything"); Success := False; elsif Kind (Pointed_Node) /= K_Property_Name_Declaration then DAE (Node1 => Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => ", which is not a property name"); Success := False; else Set_Referenced_Entity (Property_Name (Node), Pointed_Node); -- Get the type of the property association Property_Type := Property_Name_Type (Pointed_Node); end if; -- link to the referenced entity if it is relevant if Present (Property_Association_Value (Node)) then if Present (Single_Value (Property_Association_Value (Node))) then Success := Link_Property_Value (Root, Container, Single_Value (Property_Association_Value (Node)), Property_Type, Options) and then Success; else List_Node := First_Node (Multi_Value (Property_Association_Value (Node))); while Present (List_Node) loop Success := Link_Property_Value (Root, Container, List_Node, Property_Type, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; end if; -- link 'applies to' statement if not Is_Empty (Applies_To_Prop (Node)) then List_Node := First_Node (Applies_To_Prop (Node)); Pointed_Node := Container; while Present (List_Node) loop case Kind (Pointed_Node) is when K_Subcomponent | K_Port_Spec | K_Port_Group_Spec | K_Parameter | K_Subcomponent_Access | K_Subprogram_Spec | K_Subprogram_Call => Corresponding_Container := Get_Referenced_Entity (Entity_Ref (Pointed_Node)); -- for subclauses that can refer to a component, we -- retrieve the corresponding entity when K_Mode | K_Connection | K_Flow_Spec | K_Flow_Implementation | K_Flow_Implementation_Refinement | K_End_To_End_Flow_Spec | K_End_To_End_Flow_Refinement => Corresponding_Container := No_Node; -- those subclauses do not refer to any component when K_Component_Type | K_Component_Implementation => Corresponding_Container := Pointed_Node; when others => Corresponding_Container := No_Node; end case; if Present (Corresponding_Container) then Pointed_Node := Find_Subclause (Corresponding_Container, List_Node); else Pointed_Node := No_Node; end if; if Present (Pointed_Node) then Set_Corresponding_Entity (List_Node, Pointed_Node); List_Node := Next_Node (List_Node); else DAE (Node1 => Node, Message1 => " applies to something that cannot be found"); Success := False; exit; end if; end loop; if No (Pointed_Node) then DAE (Node1 => Node, Message1 => " applies to something that cannot be found"); Success := False; end if; end if; -- in modes if Present (In_Modes (Node)) and then not Is_Empty (Modes (In_Modes (Node))) then -- If the container or the pointed node of the property -- association is a mode, raise an error. if Kind (Container) = K_Mode or else (Present (Pointed_Node) and then Kind (Pointed_Node) = K_Mode) then DAE (Node1 => Node, Message1 => " belongs to a mode. It cannot have 'in modes'" & " statement"); Success := False; elsif Present (Current_Scope) and then Kind (Corresponding_Entity (Current_Scope)) = K_Component_Implementation then Success := Link_In_Modes_Statement (Component => Corresponding_Entity (Current_Scope), In_Modes => In_Modes (Node)) and then Success; else DAE (Node1 => Node, Message1 => " have 'in modes' statement but is not in " & "a component implementation"); Success := False; end if; end if; return Success; end Link_Property_Association; -------------------------------- -- Link_Property_Associations -- -------------------------------- function Link_Property_Associations (Root : Node_Id; Container : Node_Id; List : List_Id; Options : Analyzer_Options) return Boolean is List_Node : Node_Id; Success : Boolean := True; begin if not Is_Empty (List) then List_Node := First_Node (List); while Present (List_Node) loop pragma Assert (Kind (List_Node) = K_Property_Association); Success := Link_Property_Association (Root, Container, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Link_Property_Associations; ---------------------------------------------------- -- Link_Property_Associations_Of_AADL_Description -- ---------------------------------------------------- function Link_Property_Associations_Of_AADL_Description (Root : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Entity_Scope (Root)); if not Is_Empty (Declarations (Root)) then List_Node := First_Node (Declarations (Root)); while Present (List_Node) loop if Kind (List_Node) = K_Package_Specification then Success := Link_Property_Associations_Of_Package (Root => Root, Node => List_Node, Options => Options) and then Success; elsif Kind (List_Node) = K_Component_Type or else Kind (List_Node) = K_Component_Implementation or else Kind (List_Node) = K_Port_Group_Type then Success := Link_Property_Associations_Of_Component (Root => Root, Node => List_Node, Options => Options) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Property_Associations_Of_AADL_Description; --------------------------------------------- -- Link_Property_Associations_Of_Component -- --------------------------------------------- function Link_Property_Associations_Of_Component (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Component_Implementation or else Kind (Node) = K_Component_Type or else Kind (Node) = K_Port_Group_Type); Success : Boolean := False; begin case Kind (Node) is when K_Component_Type => Success := Link_Property_Associations_Of_Component_Type (Root, Node, Options); when K_Component_Implementation => Success := Link_Property_Associations_Of_Component_Implementation (Root, Node, Options); when K_Port_Group_Type => Success := Link_Property_Associations_Of_Port_Group_Type (Root, Node, Options); when others => raise Program_Error; end case; return Success; end Link_Property_Associations_Of_Component; ------------------------------------------------------------ -- Link_Property_Associations_Of_Component_Implementation -- ------------------------------------------------------------ function Link_Property_Associations_Of_Component_Implementation (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Component_Implementation); List_Node : Node_Id; Call_List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Property_Scope (Node)); if not Is_Empty (Refines_Type (Node)) then List_Node := First_Node (Refines_Type (Node)); while Present (List_Node) loop Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Subcomponents (Node)) then List_Node := First_Node (Subcomponents (Node)); while Present (List_Node) loop Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Calls (Node)) then List_Node := First_Node (Ocarina.Nodes.Calls (Node)); while Present (List_Node) loop if not Is_Empty (Subprogram_Calls (List_Node)) then Call_List_Node := First_Node (Subprogram_Calls (List_Node)); while Present (Call_List_Node) loop Success := Link_Property_Associations (Root, Node, Ocarina.Nodes.Properties (Call_List_Node), Options) and then Success; Call_List_Node := Next_Node (Call_List_Node); end loop; end if; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Connections (Node)) then List_Node := First_Node (Ocarina.Nodes.Connections (Node)); while Present (List_Node) loop Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Flows (Node)) then List_Node := First_Node (Ocarina.Nodes.Flows (Node)); while Present (List_Node) loop Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Modes (Node)) then List_Node := First_Node (Ocarina.Nodes.Modes (Node)); while Present (List_Node) loop -- Mode transitions have no property associations if Kind (List_Node) = K_Mode then Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Properties (Node)) then List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop Success := Link_Property_Association (Root, Node, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Property_Associations_Of_Component_Implementation; -------------------------------------------------- -- Link_Property_Associations_Of_Component_Type -- -------------------------------------------------- function Link_Property_Associations_Of_Component_Type (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Component_Type); List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Property_Scope (Node)); if not Is_Empty (Ocarina.Nodes.Features (Node)) then List_Node := First_Node (Ocarina.Nodes.Features (Node)); while Present (List_Node) loop Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Flows (Node)) then List_Node := First_Node (Ocarina.Nodes.Flows (Node)); while Present (List_Node) loop Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Properties (Node)) then List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop Success := Link_Property_Association (Root, Node, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Property_Associations_Of_Component_Type; ------------------------------------------- -- Link_Property_Associations_Of_Package -- ------------------------------------------- function Link_Property_Associations_Of_Package (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Package_Specification); List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Property_Scope (Node)); if not Is_Empty (Declarations (Node)) then List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop if Kind (List_Node) = K_Component_Type or else Kind (List_Node) = K_Component_Implementation or else Kind (List_Node) = K_Port_Group_Type then Success := Link_Property_Associations_Of_Component (Root, List_Node, Options) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Properties (Node)) then List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop Success := Link_Property_Association (Root, Node, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Property_Associations_Of_Package; --------------------------------------------------- -- Link_Property_Associations_Of_Port_Group_Type -- --------------------------------------------------- function Link_Property_Associations_Of_Port_Group_Type (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Port_Group_Type); List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Property_Scope (Node)); if not Is_Empty (Ocarina.Nodes.Features (Node)) then List_Node := First_Node (Ocarina.Nodes.Features (Node)); while Present (List_Node) loop Success := Link_Property_Associations (Root, List_Node, Ocarina.Nodes.Properties (List_Node), Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; if not Is_Empty (Ocarina.Nodes.Properties (Node)) then List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop Success := Link_Property_Association (Root, Node, List_Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Property_Associations_Of_Port_Group_Type; ---------------------------- -- Link_Property_Constant -- ---------------------------- function Link_Property_Constant (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Constant_Property_Declaration); pragma Assert (Present (Constant_Type (Node))); Success : Boolean := True; Pointed_Node : Node_Id; begin -- Link unit identifier if Unique_Unit_Identifier (Node) /= No_Node then Pointed_Node := Find_Property_Entity (Root, Namespace_Identifier (Unique_Unit_Identifier (Node)), Identifier (Unique_Unit_Identifier (Node)), Options => Options); if Present (Pointed_Node) then Set_Referenced_Entity (Unique_Unit_Identifier (Node), Pointed_Node); else DLTWN (Unique_Unit_Identifier (Node), Pointed_Node); Success := False; end if; end if; -- Link constant type if it is a reference to a declare -- property type. if Kind (Constant_Type (Node)) = K_Unique_Property_Type_Identifier then declare Pointed_Node : Node_Id; begin Pointed_Node := Find_Property_Entity (Root => Root, Property_Set_Identifier => Namespace_Identifier (Constant_Type (Node)), Property_Identifier => Identifier (Constant_Type (Node)), Options => Options); if No (Pointed_Node) or else Kind (Pointed_Node) /= K_Property_Type_Declaration then DLTWN (Node, Pointed_Node); Success := False; else Set_Corresponding_Entity (Identifier (Constant_Type (Node)), Pointed_Node); Set_Referenced_Entity (Constant_Type (Node), Pointed_Node); end if; end; end if; -- Link constant value(s) if Single_Value (Constant_Value (Node)) /= No_Node then Success := Link_Property_Value (Root, Corresponding_Entity (Current_Scope), Single_Value (Constant_Value (Node)), Node, Options) and then Success; else pragma Assert (Multi_Value (Constant_Value (Node)) /= No_List); declare List_Node : Node_Id; begin List_Node := First_Node (Multi_Value (Constant_Value (Node))); while Present (List_Node) loop Success := Link_Property_Value (Root, Corresponding_Entity (Current_Scope), List_Node, Node, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end; end if; return Success; end Link_Property_Constant; ------------------------ -- Link_Property_Name -- ------------------------ function Link_Property_Name (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Property_Name_Declaration); pragma Assert (Present (Property_Name_Type (Node))); Success : Boolean := True; List_Node : Node_Id; Type_Designator : constant Node_Id := Property_Type_Designator (Property_Name_Type (Node)); Property_Type : constant Node_Id := Property_Name_Type (Node); begin case Kind (Type_Designator) is when K_Unique_Property_Type_Identifier => declare Pointed_Node : Node_Id; begin Pointed_Node := Find_Property_Entity (Root => Root, Property_Set_Identifier => Namespace_Identifier (Type_Designator), Property_Identifier => Identifier (Type_Designator), Options => Options); if No (Pointed_Node) then DAE (Node1 => Node, Message1 => "does not point to anything"); Success := False; elsif Kind (Pointed_Node) /= K_Property_Type_Declaration then DAE (Node1 => Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => ", which is not a property type"); Success := False; else Set_Referenced_Entity (Type_Designator, Pointed_Node); end if; end; when K_Integer_Type | K_Real_Type => -- If the property names is of type integer or real, then we -- must link the optional unit Success := Link_Type_Designator (Root, Type_Designator, Options); when K_Range_Type => Success := Link_Type_Designator (Root, Type_Designator, Options); when others => null; end case; -- Link optional default value if Default_Value (Node) /= No_Node then if Single_Value (Default_Value (Node)) /= No_Node then Success := Link_Property_Value (Root, Corresponding_Entity (Current_Scope), Single_Value (Default_Value (Node)), Property_Type, Options) and then Success; elsif Multi_Value (Default_Value (Node)) /= No_List then declare List_Node : Node_Id; begin List_Node := First_Node (Multi_Value (Default_Value (Node))); while Present (List_Node) loop Success := Link_Property_Value (Root, Corresponding_Entity (Current_Scope), List_Node, Property_Type, Options) and then Success; List_Node := Next_Node (List_Node); end loop; end; end if; end if; -- Link optional classifier reference of the owner -- category if Owner_Categories (Applies_To (Node)) /= No_List then List_Node := First_Node (Owner_Categories (Applies_To (Node))); while Present (List_Node) loop if Classifier_Ref (List_Node) /= No_Node then Push_Scope (Entity_Scope (Root)); -- We search declarations from the root namespace, not -- from the property set namespace case Property_Owner_Category'Val (Category (List_Node)) is when POC_Component_Category => Set_Referenced_Entity (Classifier_Ref (List_Node), Find_Component_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Classifier_Ref (List_Node)), Component_Identifier => Identifier (Classifier_Ref (List_Node)), Options => Options)); when POC_Port_Group => Set_Referenced_Entity (Classifier_Ref (List_Node), Find_Port_Group_Classifier (Root => Root, Package_Identifier => Namespace_Identifier (Classifier_Ref (List_Node)), Port_Group_Identifier => Identifier (Classifier_Ref (List_Node)), Options => Options)); when others => Set_Referenced_Entity (Classifier_Ref (List_Node), No_Node); -- XXX We do not link subclauses. Is it relevant -- to do so? end case; Pop_Scope; if Get_Referenced_Entity (Classifier_Ref (List_Node)) = No_Node then Display_Link_To_Wrong_Node (Classifier_Ref (List_Node), Get_Referenced_Entity (Classifier_Ref (List_Node)), Warning => True); -- Not finding the corresponding entity is not a -- problem if the property is not to be used. end if; end if; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Link_Property_Name; ------------------------ -- Link_Property_Type -- ------------------------ function Link_Property_Type (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Property_Type_Declaration); begin return Link_Type_Designator (Root, Property_Type_Designator (Node), Options); end Link_Property_Type; ------------------------- -- Link_Property_Value -- ------------------------- function Link_Property_Value (Root : Node_Id; Container : Node_Id; Node : Node_Id; Property_Type : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Present (Container)); pragma Assert (Present (Node)); pragma Assert (No (Property_Type) or else Kind (Property_Type) = K_Real_Type or else Kind (Property_Type) = K_Integer_Type or else Kind (Property_Type) = K_Property_Type or else Kind (Property_Type) = K_Constant_Property_Declaration); Success : Boolean := True; Pointed_Node : Node_Id; Local_Scope : constant Node_Id := Current_Scope; List_Node : Node_Id; Corresponding_Container : Node_Id; begin case Kind (Node) is when K_Component_Classifier_Term => Pop_Scope; -- The current scope is supposed to be the one of the -- component we are working in. We have to retrieve the -- above scope, which is the one of the current -- namespace. Pointed_Node := Find_Component_Classifier (Root, Namespace_Identifier (Node), Identifier (Node), Options); if Present (Pointed_Node) and then Category (Pointed_Node) = Component_Cat (Node) then Set_Referenced_Entity (Node, Pointed_Node); Success := True; else DLTWN (Node, Pointed_Node); Success := False; end if; Push_Scope (Local_Scope); when K_Reference_Term => List_Node := First_Node (Path (Node)); Pointed_Node := Container; while Present (List_Node) loop case Kind (Pointed_Node) is when K_Subcomponent | K_Port_Spec | K_Port_Group_Spec | K_Parameter | K_Subcomponent_Access | K_Subprogram_Spec | K_Subprogram_Call => -- For subclauses that can refer to a component, -- we retrieve the corresponding entity. Corresponding_Container := Get_Referenced_Entity (Entity_Ref (Pointed_Node)); when K_Mode | K_Connection | K_Flow_Spec | K_Flow_Implementation | K_Flow_Implementation_Refinement | K_End_To_End_Flow_Spec | K_End_To_End_Flow_Refinement => -- For the subclauses, the container is the -- component they have been declared in. Corresponding_Container := Container_Component (Pointed_Node); when K_Component_Type | K_Component_Implementation => Corresponding_Container := Pointed_Node; when others => Corresponding_Container := No_Node; end case; if Present (Corresponding_Container) then Pointed_Node := Find_Subclause (Corresponding_Container, Item (List_Node)); else Pointed_Node := No_Node; end if; if Present (Pointed_Node) then Set_Corresponding_Entity (Item (List_Node), Pointed_Node); List_Node := Next_Node (List_Node); else DLTWN (Node, Pointed_Node); Success := False; exit; end if; end loop; if No (Pointed_Node) then DLTWN (Node, Pointed_Node); Success := False; else Set_Referenced_Entity (Node, Pointed_Node); Success := True; end if; when K_Unique_Property_Const_Identifier | K_Property_Term => if Kind (Container) = K_Component_Type or else Kind (Container) = K_Component_Implementation or else Kind (Container) = K_Port_Group_Type then Pointed_Node := Find_Property_Association (Container, Name (Full_Identifier (Node))); -- We first look for a property association if we are -- in an AADL declaration. else Pointed_Node := No_Node; end if; if No (Pointed_Node) then -- If we did not find anything, we look for a property -- name. Pointed_Node := Find_Property_Entity (Root, Namespace_Identifier (Node), Identifier (Node), Options); end if; if Present (Pointed_Node) and then (Kind (Pointed_Node) = K_Property_Association or else Kind (Pointed_Node) = K_Constant_Property_Declaration or else Kind (Pointed_Node) = K_Property_Name_Declaration) then Set_Referenced_Entity (Node, Pointed_Node); -- IMPORTANT: we do not perform any verification -- reguarding the validity of this reference: a single -- value property association may refer to a -- multi-valued constant. This is checked in the -- semantics packages. else DLTWN (Node, Pointed_Node); Success := False; end if; when K_Number_Range_Term => Success := Link_Property_Value (Root, Container, Lower_Bound (Node), Property_Type, Options); Success := Link_Property_Value (Root, Container, Upper_Bound (Node), Property_Type, Options) and then Success; if Delta_Term (Node) /= No_Node then Success := Link_Property_Value (Root, Container, Delta_Term (Node), Property_Type, Options) and then Success; end if; when K_Minus_Numeric_Term => Success := Link_Property_Value (Root, Container, Numeric_Term (Node), Property_Type, Options); when K_Literal => Success := True; -- Boolean terms must be followed to look for boolean -- property terms. when K_And_Boolean_Term | K_Or_Boolean_Term => Success := Link_Property_Value (Root, Container, First_Term (Node), Property_Type, Options); Success := Link_Property_Value (Root, Container, Second_Term (Node), Property_Type, Options) and then Success; when K_Not_Boolean_Term | K_Parenthesis_Boolean_Term => Success := Link_Property_Value (Root, Container, Boolean_Term (Node), Property_Type, Options); when K_Signed_AADLNumber => -- If the number has a unit identifier, link it to the -- corresponfing identifier of the unit type. We do not -- this test if the propoerty type was not found to avoid -- cascading errors. if Present (Property_Type) then declare Unit_Type : constant Node_Id := Unwind_Units_Type (Property_Type); V_Unit_Id : constant Node_Id := Unit_Identifier (Node); Unit_Id : Node_Id; Compatible_Unit_Types : Boolean := False; begin if Present (Unit_Identifier (Node)) and then Present (Property_Type) then if No (Unit_Type) then DAE (Node1 => Node, Message1 => " is a unit literal but ", Node2 => Property_Type, Message2 => " is not a unit type"); Success := False; end if; if Success then -- Link the units identifier of the value to -- its corresponding units identifier. Unit_Id := Base_Identifier (Unit_Type); if Equals (V_Unit_Id, Unit_Id) then Set_Corresponding_Entity (V_Unit_Id, Unit_Id); Compatible_Unit_Types := True; else Unit_Id := First_Node (Unit_Definitions (Unit_Type)); while Present (Unit_Id) loop if Equals (V_Unit_Id, Identifier (Unit_Id)) then Set_Corresponding_Entity (V_Unit_Id, Identifier (Unit_Id)); Compatible_Unit_Types := True; end if; Unit_Id := Next_Node (Unit_Id); end loop; end if; if not Compatible_Unit_Types then DAE (Node1 => Node, Message1 => " and ", Node2 => Property_Type, Message2 => " have incompatible unit types"); Success := False; end if; end if; elsif Present (Unit_Type) then -- We accept that the user does not give the -- unit for a literal only in the case where the -- units type contains only one unit identifier. if not Is_Empty (Unit_Definitions (Unit_Type)) then DAE (Node1 => Node, Message1 => " is not a unit literal but ", Node2 => Property_Type, Message2 => " is a unit type"); Success := False; end if; end if; end; end if; when others => null; end case; return Success; end Link_Property_Value; --------------------------------------------------- -- Link_Subclauses_In_Components_And_Port_Groups -- --------------------------------------------------- function Link_Subclauses_In_Components_And_Port_Groups (Root : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); List_Node : Node_Id; Package_List_Node : Node_Id; Success : Boolean := True; begin Push_Scope (Entity_Scope (Root)); if not Is_Empty (Declarations (Root)) then List_Node := First_Node (Declarations (Root)); while Present (List_Node) loop case Kind (List_Node) is when K_Component_Type => Success := Link_Component_Type_Subclauses (Root, List_Node, Options) and then Success; when K_Component_Implementation => Success := Link_Component_Implementation_Subclauses (Root, List_Node, Options) and then Success; when K_Port_Group_Type => Success := Link_Port_Group_Type_Subclauses (Root, List_Node, Options) and then Success; when K_Package_Specification => Push_Scope (Entity_Scope (List_Node)); if not Is_Empty (Declarations (List_Node)) then Package_List_Node := First_Node (Declarations (List_Node)); while Present (Package_List_Node) loop case Kind (Package_List_Node) is when K_Component_Type => Success := Link_Component_Type_Subclauses (Root, Package_List_Node, Options) and then Success; when K_Component_Implementation => Success := Link_Component_Implementation_Subclauses (Root, Package_List_Node, Options) and then Success; when K_Port_Group_Type => Success := Link_Port_Group_Type_Subclauses (Root, Package_List_Node, Options) and then Success; when others => null; end case; Package_List_Node := Next_Node (Package_List_Node); end loop; end if; Pop_Scope; when others => null; end case; List_Node := Next_Node (List_Node); end loop; end if; Pop_Scope; return Success; end Link_Subclauses_In_Components_And_Port_Groups; ----------------------- -- Link_Subcomponent -- ----------------------- function Link_Subcomponent (Root : Node_Id; Node : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Node) = K_Subcomponent); Success : Boolean := True; Pointed_Node : Node_Id; No_Ref_Given : Boolean := False; -- The reference is optional Component_Ref : constant Node_Id := Entity_Ref (Node); Component_Identifier : Node_Id; Pack_Identifier : Node_Id; begin if Present (Component_Ref) then Component_Identifier := Identifier (Component_Ref); -- XXX We only link with the component type, no matter if an -- implementation is specified. The tree structure should be -- changed so that a Classifier_Ref has a single identifier -- instead of two. Pack_Identifier := Namespace_Identifier (Component_Ref); Pointed_Node := Find_Component_Classifier (Root => Root, Package_Identifier => Pack_Identifier, Component_Identifier => Component_Identifier, Options => Options); else Pointed_Node := No_Node; No_Ref_Given := True; end if; if No (Pointed_Node) then if No_Ref_Given then Success := True; else DLTWN (Node, Pointed_Node); Success := False; end if; elsif not ((Kind (Pointed_Node) = K_Component_Type or else Kind (Pointed_Node) = K_Component_Implementation)) then DAE (Node1 => Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => ", which is not a component "); Success := False; elsif Category (Pointed_Node) /= Category (Node) then DAE (Node1 => Node, Message1 => " points to ", Node2 => Pointed_Node, Message2 => ", which is not of the same kind "); Success := False; else Set_Referenced_Entity (Entity_Ref (Node), Pointed_Node); Success := True; end if; return Success; end Link_Subcomponent; -------------------------- -- Link_Type_Designator -- -------------------------- function Link_Type_Designator (Root : Node_Id; Designator : Node_Id; Options : Analyzer_Options) return Boolean is pragma Assert (Kind (Root) = K_AADL_Specification); pragma Assert (Kind (Designator) = K_Boolean_Type or else Kind (Designator) = K_String_Type or else Kind (Designator) = K_Enumeration_Type or else Kind (Designator) = K_Units_Type or else Kind (Designator) = K_Real_Type or else Kind (Designator) = K_Integer_Type or else Kind (Designator) = K_Classifier_Type or else Kind (Designator) = K_Reference_Type or else Kind (Designator) = K_Range_Type); Success : Boolean := True; Pointed_Node : Node_Id; begin case Kind (Designator) is when K_Integer_Type | K_Real_Type => if Present (Unit_Designator (Designator)) and then Kind (Unit_Designator (Designator)) = K_Unique_Property_Type_Identifier then Pointed_Node := Find_Property_Entity (Root => Root, Property_Set_Identifier => Namespace_Identifier (Unit_Designator (Designator)), Property_Identifier => Identifier (Unit_Designator (Designator)), Options => Options); if No (Pointed_Node) then DAE (Node1 => Unit_Designator (Designator), Message1 => "does not point to anything"); Success := False; elsif Kind (Pointed_Node) /= K_Property_Type_Declaration then DAE (Node1 => Unit_Designator (Designator), Message1 => " points to ", Node2 => Pointed_Node, Message2 => ", which is not a unit declaration"); Success := False; else Set_Referenced_Entity (Unit_Designator (Designator), Pointed_Node); end if; end if; if Present (Type_Range (Designator)) then Success := Link_Property_Value (Root, Corresponding_Entity (Current_Scope), Lower_Bound (Type_Range (Designator)), Designator, Options) and then Success; Success := Link_Property_Value (Root, Corresponding_Entity (Current_Scope), Upper_Bound (Type_Range (Designator)), Designator, Options) and then Success; end if; when K_Range_Type => if Present (Number_Type (Designator)) then if Kind (Number_Type (Designator)) = K_Unique_Property_Type_Identifier then Pointed_Node := Find_Property_Entity (Root => Root, Property_Set_Identifier => Namespace_Identifier (Number_Type (Designator)), Property_Identifier => Identifier (Number_Type (Designator)), Options => Options); if No (Pointed_Node) then DAE (Node1 => Number_Type (Designator), Message1 => "does not point to anything"); Success := False; else Set_Referenced_Entity (Number_Type (Designator), Pointed_Node); end if; elsif Kind (Number_Type (Designator)) = K_Integer_Type or else Kind (Number_Type (Designator)) = K_Real_Type then Success := Link_Type_Designator (Root, Number_Type (Designator), Options); end if; end if; when others => null; end case; return Success; end Link_Type_Designator; ----------------------------- -- Retrieve_Connection_End -- ----------------------------- procedure Retrieve_Connection_End (Component : Node_Id; Connection_End : Node_Id; Corresponding_Node : out Node_Id; Is_Local : out Boolean) is pragma Assert (Kind (Component) = K_Component_Implementation); pragma Assert (Kind (Connection_End) = K_Entity_Reference); begin if not Entity_Reference_Path_Has_Several_Elements (Connection_End) then -- The connection end is something like 'name'. It can -- either be a feature or a subcomponent. We begin searching -- a subcomponent, as they are the closest declarations Is_Local := True; Corresponding_Node := Find_Subcomponent (Component => Component, Subcomponent_Identifier => Item (First_Node (Path (Connection_End)))); if No (Corresponding_Node) then Corresponding_Node := Find_Feature (Component => Component, Feature_Identifier => Item (First_Node (Path (Connection_End)))); end if; Set_Corresponding_Entity (Item (First_Node (Path (Connection_End))), Corresponding_Node); else -- The connection end is like 'name.name'. It is a feature -- of a subcomponent or a parameter of a subprogram call. We -- first find the subcomponent, and then the feature of the -- corresponding component type or implementation. Is_Local := False; Corresponding_Node := Find_Subcomponent (Component => Component, Subcomponent_Identifier => Item (First_Node (Path (Connection_End)))); if No (Corresponding_Node) then -- If we did not find a suitable subcomponent, maybe it -- is a subprogram call. Corresponding_Node := Find_Subprogram_Call (Component => Component, Call_Identifier => Item (First_Node (Path (Connection_End)))); end if; if No (Corresponding_Node) then -- If we did not find a suitable subcomponent, maybe it -- is a port group in the feature section. Corresponding_Node := Find_Feature (Component => Component, Feature_Identifier => Item (First_Node (Path (Connection_End)))); end if; Set_Corresponding_Entity (Item (First_Node (Path (Connection_End))), Corresponding_Node); if Present (Corresponding_Node) then if Kind (Corresponding_Node) = K_Subcomponent and then Get_Referenced_Entity (Entity_Ref (Corresponding_Node)) /= No_Node then Corresponding_Node := Find_Feature (Component => Get_Referenced_Entity (Entity_Ref (Corresponding_Node)), Feature_Identifier => Item (Next_Node (First_Node (Path (Connection_End))))); elsif Kind (Corresponding_Node) = K_Subprogram_Call and then Get_Referenced_Entity (Entity_Ref (Corresponding_Node)) /= No_Node then Corresponding_Node := Find_Feature (Component => Get_Referenced_Entity (Entity_Ref (Corresponding_Node)), Feature_Identifier => Item (Next_Node (First_Node (Path (Connection_End))))); elsif Kind (Corresponding_Node) = K_Port_Group_Spec and then Present (Get_Referenced_Entity (Entity_Ref (Corresponding_Node))) then Corresponding_Node := Find_Feature (Component => Get_Referenced_Entity (Entity_Ref (Corresponding_Node)), Feature_Identifier => Item (Next_Node (First_Node (Path (Connection_End))))); Is_Local := True; else Corresponding_Node := No_Node; end if; Set_Corresponding_Entity (Item (Next_Node (First_Node (Path (Connection_End)))), Corresponding_Node); end if; end if; end Retrieve_Connection_End; ----------------------- -- Unwind_Units_Type -- ----------------------- function Unwind_Units_Type (Property_Type : Node_Id) return Node_Id is begin -- To unwind the multiple level defined types, we use recusion. case Kind (Property_Type) is when K_Real_Type | K_Integer_Type => -- This is the most basic case given on a first recursion -- level. Units are *always* defined in an integer type -- or a real type. If this type does not contain a unit -- designator, this means that there is not a unit -- definition in the whole type definition. if Present (Unit_Designator (Property_Type)) then return Unwind_Units_Type (Unit_Designator (Property_Type)); else return No_Node; end if; when K_Constant_Property_Declaration => -- When unwinding a constant type declaration, we first -- look if the unit definition is given in the constant -- type declaration. Otherwise we unwind the constant -- type. if Present (Unique_Unit_Identifier (Property_Type)) then return Unwind_Units_Type (Unique_Unit_Identifier (Property_Type)); else return Unwind_Units_Type (Constant_Type (Property_Type)); end if; when K_Property_Type => -- Unwind the property type designator return Unwind_Units_Type (Property_Type_Designator (Property_Type)); -- All the cases below correspond to the intermediary -- recursion levels. when K_Range_Type => -- Unwind the integer or the real type defined in the -- range type. return Unwind_Units_Type (Number_Type (Property_Type)); when K_Unique_Property_Type_Identifier => return Unwind_Units_Type (Property_Type_Designator (Get_Referenced_Entity (Property_Type))); when K_Units_Type => return Property_Type; -- No match, there is no units type definition when others => return No_Node; end case; end Unwind_Units_Type; end Ocarina.Analyzer.Links;