ocarina-analyzer-aadl-links.adb

------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--          O C A R I N A . A N A L Y Z E R . A A D L . L I N K S           --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--       Copyright (C) 2009 Telecom ParisTech, 2010-2014 ESA & ISAE.        --
--                                                                          --
-- 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 TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
--                                                                          --
------------------------------------------------------------------------------

with Utils;

with Ocarina.Analyzer.Messages;
with Ocarina.Analyzer.AADL.Semantics;
with Ocarina.Analyzer.AADL.Finder;
with Ocarina.Analyzer.AADL.Naming_Rules;

with Ocarina.ME_AADL;
with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Tree.Nutils;
with Ocarina.ME_AADL.AADL_Tree.Entities;
with Ocarina.ME_AADL.AADL_Tree.Entities.Properties;

package body Ocarina.Analyzer.AADL.Links is

   use Utils;
   use Ocarina.Analyzer.Messages;
   use Ocarina.Analyzer.AADL.Finder;
   use Ocarina.Analyzer.AADL.Naming_Rules;
   use Ocarina.ME_AADL;
   use Ocarina.ME_AADL.AADL_Tree.Nodes;
   use Ocarina.ME_AADL.AADL_Tree.Nutils;
   use Ocarina.ME_AADL.AADL_Tree.Entities;
   use Ocarina.ME_AADL.AADL_Tree.Entities.Properties;

   Global_Root : Node_Id := No_Node;
   --  Store the root of the current AADL_Specification

   function Link_Declarations_Of_Package
     (Root : Node_Id;
      Node : Node_Id) 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) 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) 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) return Boolean;
   --  Perform all the designator and identifier links in the
   --  subclauses (features...) of a component type.

   function Link_Feature_Group_Type_Subclauses
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
   --  Perform all the designator and identifier links in the
   --  subclauses (features...) of a port group (AADL_V1) or
   --  a feature group (AADL_V2)

   function Link_Properties_Of_Component_Type
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
   --  Perform all the designator and identifier links in the property
   --  associations of a component type.

   function Link_Properties_Of_Component_Implementation
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
   --  Perform all the designator and identifier links in the property
   --  associations of a component implementation.

   function Link_Properties_Of_Feature_Group_Type
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
   --  Perform all the designator and identifier links in the property
   --  associations of a port group (AADL_V1) or a feature group (AADL_V2)

   function Link_Property_Value
     (Root               : Node_Id;
      Container          : Node_Id;
      Property_Container : Node_Id;
      Node               : Node_Id;
      Property_Type      : Node_Id) return Boolean;
   --  Perform all the designator and identifier links in the property
   --  value 'Node'.

   function Link_Type_Designator
     (Root       : Node_Id;
      Designator : Node_Id) return Boolean;
   --  Perform the designator and identifier link of a property type.

   function Link_Properties_Of_Package
     (Root : Node_Id;
      Node : Node_Id) 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 Link_Flow_Feature
     (Feature_Identifier : Node_Id;
      Component          : Node_Id) return Node_Id;
   --  Return the feature instance having the identifier
   --  'Feature_Identifier' in the component 'Component'. Perform all
   --  the necessary links between the reference and the found
   --  entities.

   function Link_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 component 'Component' in the modes
   --  'In_Modes'. This function performs all the necessary links
   --  between the reference and the found entities.

   function Link_Flow_Connections (Flow : Node_Id) return Boolean;
   --  Performs links and checks on the flow connection list.

   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
     (Root          : Node_Id;
      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;

   -------------------------------
   -- Link_Flow_Of_Subcomponent --
   -------------------------------

   function Link_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
      --  The entity reference must be in the form "a.b", otherwise it
      --  cannot be a path of a subcomponent.

      if Length (Path (Flow_Identifier)) /= 2 then
         return No_Node;
      end if;

      --  Fetch "a" and link it

      Pointed_Node :=
        Find_Subcomponent
          (Component               => Component,
           Subcomponent_Identifier =>
             Item (First_Node (Path (Flow_Identifier))),
           In_Modes => In_Modes);

      Set_Corresponding_Entity
        (Item (First_Node (Path (Flow_Identifier))),
         Pointed_Node);

      Display_Node_Link
        (Item (First_Node (Path (Flow_Identifier))),
         Pointed_Node);

      if Present (Pointed_Node) then
         --  Fetch "b" and link it

         Pointed_Component :=
           Get_Referenced_Entity (Entity_Ref (Pointed_Node));

         Pointed_Node :=
           Find_Flow_Spec
             (Pointed_Component,
              Item (Next_Node (First_Node (Path (Flow_Identifier)))));

         Set_Corresponding_Entity
           (Item (Next_Node (First_Node (Path (Flow_Identifier)))),
            Pointed_Node);

         Set_Referenced_Entity (Flow_Identifier, Pointed_Node);

         Display_Node_Link
           (Item (Next_Node (First_Node (Path (Flow_Identifier)))),
            Pointed_Node);
      end if;

      return Pointed_Node;
   end Link_Flow_Of_Subcomponent;

   -----------------------
   -- Link_Flow_Feature --
   -----------------------

   function Link_Flow_Feature
     (Feature_Identifier : Node_Id;
      Component          : Node_Id) return Node_Id
   is
      pragma Assert (Kind (Feature_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 (Feature_Identifier))));

      Set_Corresponding_Entity
        (Item (First_Node (Path (Feature_Identifier))),
         Pointed_Node);

      Display_Node_Link
        (Item (First_Node (Path (Feature_Identifier))),
         Pointed_Node);

      if Present (Next_Node (First_Node (Path (Feature_Identifier)))) 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 (Feature_Identifier)))));

         Set_Corresponding_Entity
           (Item (Next_Node (First_Node (Path (Feature_Identifier)))),
            Pointed_Node);

         Set_Referenced_Entity (Feature_Identifier, Pointed_Node);

         Display_Node_Link
           (Next_Node (First_Node (Path (Feature_Identifier))),
            Pointed_Node);
      end if;

      if Present (Pointed_Node)
        and then Kind (Pointed_Node) /= K_Port_Spec
        and then Kind (Pointed_Node) /= K_Feature_Group_Spec
        and then Kind (Pointed_Node) /= K_Parameter
      then
         return No_Node;
      else
         return Pointed_Node;
      end if;
   end Link_Flow_Feature;

   ---------------
   -- Link_Call --
   ---------------

   function Link_Call (Root : Node_Id; Node : Node_Id) 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
      --  Either look in available components

      Pointed_Node :=
        Find_Component_Classifier
          (Root                 => Root,
           Package_Identifier   => Pack_Identifier,
           Component_Identifier => Identifier (Subprogram_Ref));

      --  or in local subclauses

      if No (Pointed_Node) then
         Pointed_Node :=
           Find_Subclause
             (Container_Component (Parent_Sequence (Node)),
              Identifier (Subprogram_Ref));
      end if;

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

         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
          or else Kind (Pointed_Node) = K_Subcomponent)

         and then
           Component_Category'Val (Category (Pointed_Node)) =
           CC_Subprogram);

      case AADL_Version is
         when AADL_V1 =>
            Other_Pointed_Node_Is_Ok :=
              Present (Other_Pointed_Node)
              and then Kind (Other_Pointed_Node) = K_Subprogram_Spec;

         when AADL_V2 =>
            Other_Pointed_Node_Is_Ok :=
              Present (Other_Pointed_Node)
              and then Kind (Other_Pointed_Node) = K_Subcomponent_Access;
      end case;

      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, No_Node) 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) 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.ME_AADL.AADL_Tree.Nodes.Refines_Type (Node))
      then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Refines_Type (Node));

         while Present (List_Node) loop
            Success :=
              Link_Feature (Root, List_Node, No_Node) and then Success;
            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      if not Is_Empty
          (Ocarina.ME_AADL.AADL_Tree.Nodes.Subcomponents (Node))
      then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Subcomponents (Node));

         while Present (List_Node) loop
            Success :=
              Link_Subcomponent (Root, 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 not Is_Empty (Ocarina.ME_AADL.AADL_Tree.Nodes.Calls (Node)) then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.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) 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.ME_AADL.AADL_Tree.Nodes.Connections (Node))
      then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Connections (Node));

         while Present (List_Node) loop
            Global_Root := Root;
            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);
            Global_Root := No_Node;
         end loop;
      end if;

      if Subclause_Success
        and then not Is_Empty (Ocarina.ME_AADL.AADL_Tree.Nodes.Flows (Node))
      then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.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.ME_AADL.AADL_Tree.Nodes.Modes (Node))
      then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.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) 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));
      --  According to the AADL syntax, the component type must be 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_Feature_Group_Extension --
   -----------------------------------------------

   function Link_Component_Or_Feature_Group_Extension
     (Root : Node_Id;
      Node : Node_Id) 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_Feature_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_Feature_Group_Type then
               Pointed_Node :=
                 Find_Port_Group_Classifier
                   (Root                  => Root,
                    Package_Identifier    => Pack_Identifier,
                    Port_Group_Identifier => Identifier (Component_Ref));
            else
               Pointed_Node :=
                 Find_Component_Classifier
                   (Root                 => Root,
                    Package_Identifier   => Pack_Identifier,
                    Component_Identifier => Identifier (Component_Ref));

            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_Feature_Group_Type
           and then
           (Category (Pointed_Node) /= Component_Category'Pos (CC_Abstract)
            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_Feature_Group_Extension;

   ------------------------------------
   -- Link_Component_Type_Subclauses --
   ------------------------------------

   function Link_Component_Type_Subclauses
     (Root : Node_Id;
      Node : Node_Id) 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, Node) and then Success;
            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      if not Is_Empty (Ocarina.ME_AADL.AADL_Tree.Nodes.Flows (Node)) then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.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) 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)
                 and then Success;

            elsif Kind (List_Node) = K_Property_Set then
               Success :=
                 Link_Declarations_Of_Property_Set
                   (Root => Root,
                    Node => List_Node)
                 and then Success;

            elsif Kind (List_Node) = K_Component_Type
              or else Kind (List_Node) = K_Component_Implementation
              or else Kind (List_Node) = K_Feature_Group_Type
            then
               Success :=
                 Link_Component_Or_Feature_Group_Extension
                   (Root => Root,
                    Node => List_Node)
                 and then Success;
            end if;

            if Kind (List_Node) = K_Component_Implementation then
               Success :=
                 Link_Component_Implementation_To_Component_Type
                   (Root,
                    List_Node)
                 and then Success;
            end if;

            if Kind (List_Node) = K_Feature_Group_Type then
               Success :=
                 Link_Inverse_Of_Feature_Group_Type (Root, List_Node)
                 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) 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_Feature_Group_Type
            then
               Success :=
                 Link_Component_Or_Feature_Group_Extension (Root, List_Node)
                 and then Success;
            end if;

            if Kind (List_Node) = K_Component_Implementation then
               Success :=
                 Link_Component_Implementation_To_Component_Type
                   (Root,
                    List_Node)
                 and then Success;
            end if;

            if Kind (List_Node) = K_Feature_Group_Type then
               Success :=
                 Link_Inverse_Of_Feature_Group_Type (Root, List_Node)
                 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) 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_Definition_Declaration =>
                  Success :=
                    Link_Property_Name (Root, List_Node) and then Success;

               when K_Property_Type_Declaration =>
                  Success :=
                    Link_Property_Type (Root, List_Node) and then Success;

               when K_Constant_Property_Declaration =>
                  Success :=
                    Link_Property_Constant (Root, List_Node) 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;
      Pointed_Node : Node_Id;
   begin
      case Kind (Flow) is
         when K_End_To_End_Flow_Spec =>
            --  The Source_Flow field must point to a subcomponent
            --  flow source or path.

            Pointed_Node :=
              Link_Flow_Of_Subcomponent
                (Component       => Component,
                 Flow_Identifier => Source_Flow (Flow),
                 In_Modes        => In_Modes (Flow));

            if No (Pointed_Node) then
               DLTWN (Source_Flow (Flow), Pointed_Node);
               Success := False;
            elsif Flow_Category'Val (Category (Pointed_Node)) /= FC_Source
              and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path
            then
               DAE
                 (Node1    => Source_Flow (Flow),
                  Message1 => " points to ",
                  Node2    => Pointed_Node,
                  Message2 => " which should be a flow source or flow path");
               Success := False;
            end if;

            --  The Sink_Flow field must point to a subcomponent flow
            --  sink or path.

            Pointed_Node :=
              Link_Flow_Of_Subcomponent
                (Component       => Component,
                 Flow_Identifier => Sink_Flow (Flow),
                 In_Modes        => In_Modes (Flow));

            if No (Pointed_Node) then
               DLTWN (Sink_Flow (Flow), Pointed_Node);
               Success := False;
            elsif Flow_Category'Val (Category (Pointed_Node)) /= FC_Sink
              and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path
            then
               DAE
                 (Node1    => Sink_Flow (Flow),
                  Message1 => " points to ",
                  Node2    => Pointed_Node,
                  Message2 => " which should be a flow sink or flow path");
               Success := False;
            end if;

            Success := Link_Flow_Connections (Flow) and then Success;

         when others =>
            null;
      end case;

      return Success;
   end Link_End_To_End_Flow_Spec;

   ------------------
   -- Link_Feature --
   ------------------

   function Link_Feature
     (Root           : Node_Id;
      Node           : Node_Id;
      Component_Type : Node_Id) return Boolean
   is
      use Ocarina.Analyzer.AADL.Semantics;

      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_Feature_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 refer to components (e.g. data ports)
   begin
      if AADL_Version = AADL_V2
        and then Present (Entity_Ref (Node))
        and then Present (Namespace_Identifier (Entity_Ref (Node)))
      then
         Success :=
           Check_Qualified_References
             (Namespace (Container_Component (Node)),
              Entity_Ref (Node));
      end if;

      if Success then
         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));

                        if No (Pointed_Node)
                          and then Present (Component_Type)
                        then
                           Pointed_Node :=
                             Find_Prototype
                               (Component_Type,
                                Identifier (Component_Ref));
                        end if;

                        if No (Pointed_Node) then
                           DLTWN (Node, Component_Ref);
                           Success := False;
                        end if;
                     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)
                       and then not (Kind (Pointed_Node) = K_Prototype)
                     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_Feature_Group_Spec =>
               declare
                  Port_Group_Ref : Node_Id := Entity_Ref (Node);
               begin
                  if No (Port_Group_Ref) then
                     --  If Entity_Ref is null, look for inverse
                     Port_Group_Ref := Inverse_Of (Node);
                  end if;

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

                     Other_Pointed_Node :=
                       Find_Component_Classifier
                         (Root               => Root,
                          Package_Identifier =>
                            Namespace_Identifier (Subprog_Ref),
                          Component_Identifier =>
                            Item (First_Node (Path (Subprog_Ref))));

                     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));
                  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;
      end if;

      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;
      C : constant Flow_Category := Flow_Category'Val (Category (Flow));
      Pointed_Node : Node_Id;
   begin
      case Kind (Flow) is
         when K_Flow_Implementation =>
            --  Check for existing flow spec

            if No (Corresponding_Flow_Spec (Flow)) then
               DAE
                 (Node1    => Flow,
                  Message1 => " does not have a corresponding flow spec");
               Success := False;
            else
               --  In case of a flow source or a flow path, the
               --  Source_Flow field is a feature.

               if C = FC_Source or else C = FC_Path then
                  Pointed_Node :=
                    Link_Flow_Feature
                      (Component          => Component,
                       Feature_Identifier => Source_Flow (Flow));

                  Set_Corresponding_Entity
                    (Item (First_Node (Path (Source_Flow (Flow)))),
                     Pointed_Node);
                  Set_Referenced_Entity (Source_Flow (Flow), Pointed_Node);

                  Display_Node_Link (Source_Flow (Flow), Pointed_Node);

                  if No (Pointed_Node) then
                     DAE
                       (Node1    => Source_Flow (Flow),
                        Message1 => " does not point to a feature");
                     Success := False;
                  else
                     --  Check that the source is the same as in the
                     --  flow spec.

                     if Get_Referenced_Entity (Source_Flow (Flow)) /=
                       Get_Referenced_Entity
                         (Source_Flow (Corresponding_Flow_Spec (Flow)))
                     then
                        DAE
                          (Node1    => Flow,
                           Message1 =>
                             " and its corresponding flow spec" &
                             " have different sources");