------------------------------------------- ------------------------------------- -- -- -- 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;