Parse connections in deployment view

src/deployment_view.adb

@@ -7,6 +7,7 @@
 with --  Ada.Text_IO,
      --  Ada.Exceptions,
      --  Ocarina.Instances.Queries,
+     Ocarina.Backends.Properties,
      Ocarina.Instances,
      Ocarina.Namet,
      Ocarina.Analyzer,
@@ -21,6 +22,7 @@ package body Deployment_View is
    use --  Ada.Text_IO,
        --  Ada.Exceptions,
        --  Ocarina.Instances.Queries,
+       Ocarina.Backends.Properties,
        Ocarina.Namet,
        Ocarina.ME_AADL.AADL_Instances.Nodes,
        Ocarina.ME_AADL.AADL_Instances.Nutils,
@@ -59,6 +61,7 @@ package body Deployment_View is
       use type Taste_Busses.Vector;
       Nodes          : Node_Maps.Map;
       Busses         : Taste_Busses.Vector;
+      Conns          : Bus_Connections.Vector;
       My_Root_System : Node_Id;
       Subs           : Node_Id;
       CI             : Node_Id;
@@ -91,6 +94,62 @@ package body Deployment_View is
                            Classifier   => US (Get_Name_String (Classifier)),
                            Properties   => Properties);
       end Parse_Bus;
+
+      function Parse_Connections (CI : Node_Id) return Bus_Connections.Vector
+      is
+         use Bus_Connections;
+         Conn           : Node_Id;
+         Bound_Bus      : Node_Id;
+         Src_Port       : Node_Id;
+         Src_Name       : Unbounded_String;
+         Dst_Name       : Unbounded_String;
+         Dst_Port       : Node_Id;
+         Bound_Bus_Name : Name_Id;
+         If1_Name       : Name_Id;
+         If2_Name       : Name_Id;
+         Result         : Bus_Connections.Vector;
+      begin
+         Conn := First_Node (Connections (CI));
+         while Present (Conn) loop
+            Bound_Bus := Get_Bound_Bus (Conn, False);
+            if Bound_Bus /= No_Node then
+               Bound_Bus_Name := Name
+                  (Identifier (Parent_Subcomponent (Bound_Bus)));
+               Src_Port := Get_Referenced_Entity (Source (Conn));
+               Dst_Port := Get_Referenced_Entity (Destination (Conn));
+               If1_Name := Get_Interface_Name (Src_Port);
+               If2_Name := Get_Interface_Name (Dst_Port);
+               --  Get_Interface_Name is v1.3.5+ only
+               if If1_Name /= No_Name and If2_Name /= No_Name then
+                  Src_Name := US (Get_Name_String (If1_Name));
+                  Dst_Name := US (Get_Name_String (If2_Name));
+               else
+                  --  Keep compatibility with v1.2
+                  Src_Name := US (Get_Name_String (Display_Name
+                                                  (Identifier (Src_Port))));
+
+                  Dst_Name := US (Get_Name_String (Display_Name
+                                                  (Identifier (Dst_Port))));
+               end if;
+               Result := Result
+                 & Bus_Connection'(Source_Node => Src_Name,
+                                   Source_Port => US (Get_Name_String
+                                     (Name (Identifier
+                                      (Parent_Subcomponent
+                                           (Parent_Component (Src_Port)))))),
+                                   Bus_Name    =>
+                                     US (Get_Name_String (Bound_Bus_Name)),
+                                   Dest_Node   => Dst_Name,
+                                   Dest_Port   => US (Get_Name_String
+                                     (Name (Identifier
+                                      (Parent_Subcomponent
+                                           (Parent_Component (Src_Port)))))));
+            end if;
+            Conn := Next_Node (Conn);
+         end loop;
+         return Result;
+      end Parse_Connections;
+
    begin
       My_Root_System := Initialize (System);
 
@@ -104,7 +163,10 @@ package body Deployment_View is
          CI := Corresponding_Instance (Subs);
 
          if Get_Category_Of_Component (CI) = CC_System then
-            null;
+            if not Is_Empty (Connections (CI)) then
+               Conns := Parse_Connections (CI);
+            end if;
+
 --            Browse_Deployment_View_System
 --                (CI, Get_Name_String (Name (Identifier (Subs))));
          elsif Get_Category_Of_Component (CI) = CC_Bus then
@@ -115,6 +177,7 @@ package body Deployment_View is
 
       return DV_AST : constant Complete_Deployment_View :=
         (Nodes          => Nodes,
+         Connections    => Conns,
          Busses         => Busses);
    end AADL_To_Ada_DV;
 

src/deployment_view.ads

@@ -6,7 +6,6 @@
 
 with Ocarina,
      Ocarina.Types,
-     --  Ocarina.Backends.Properties,
      Ada.Containers.Indefinite_Ordered_Maps,
      Ada.Containers.Indefinite_Vectors,
      Ada.Strings.Unbounded,
@@ -15,7 +14,6 @@ with Ocarina,
 
 use Ocarina,
     Ocarina.Types,
-    --  Ocarina.Backends.Properties,
     Ada.Containers,
     Ada.Strings.Unbounded,
     Parser_Utils;
@@ -50,10 +48,22 @@ package Deployment_View is
 
    package Taste_Busses is new Indefinite_Vectors (Natural, Taste_Bus);
 
+   type Bus_Connection is
+      record
+         Source_Node : Unbounded_String;
+         Source_Port : Unbounded_String;
+         Bus_Name    : Unbounded_String;
+         Dest_Node   : Unbounded_String;
+         Dest_Port   : Unbounded_String;
+      end record;
+
+   package Bus_Connections is new Indefinite_Vectors (Natural, Bus_Connection);
+
    type Complete_Deployment_View is tagged
       record
-         Nodes  : Node_Maps.Map;
-         Busses : Taste_Busses.Vector;
+         Nodes       : Node_Maps.Map;
+         Connections : Bus_Connections.Vector;
+         Busses      : Taste_Busses.Vector;
       end record;
 
    --  Function to build up the Ada AST by transforming the one from Ocarina

src/interface_view.adb

@@ -121,17 +121,6 @@ package body Interface_View is
       return Get_String_Property (D, Ellidiss_Tool_Version);
    end Get_Ellidiss_Tool_Version;
 
-   ------------------------
-   -- Get_Interface_Name --
-   ------------------------
-
-   function Get_Interface_Name (D : Node_Id) return Name_Id is
-      Interface_Name : constant Name_id :=
-         Get_String_Name ("taste::interfacename");
-   begin
-      return Get_String_Property (D, Interface_Name);
-   end Get_Interface_Name;
-
    ---------------------------
    -- Get ASN.1 Module name --
    ---------------------------

src/interface_view.ads

@@ -68,8 +68,6 @@ package Interface_View is
 
    function Get_Ellidiss_Tool_Version (D : Node_Id) return Name_Id;
 
-   function Get_Interface_Name (D : Node_Id) return Name_Id;
-
    function Get_ASN1_Module_Name (D : Node_Id) return String;
 
    type Parameter_Direction is (param_in, param_out);

src/parser_utils.adb

@@ -107,6 +107,17 @@ package body Parser_Utils is
       end if;
    end Get_APLC_Binding;
 
+   ------------------------
+   -- Get_Interface_Name --
+   ------------------------
+
+   function Get_Interface_Name (D : Node_Id) return Name_Id is
+      Interface_Name : constant Name_id :=
+         Get_String_Name ("taste::interfacename");
+   begin
+      return Get_String_Property (D, Interface_Name);
+   end Get_Interface_Name;
+
    --------------------------------------------
    -- Get all properties as a Map Key/String --
    -- Input parameter is an AADL instance    --

src/parser_utils.ads

@@ -55,6 +55,8 @@ package Parser_Utils is
 
    function Get_APLC_Binding (E : Node_Id) return List_Id;
 
+   function Get_Interface_Name (D : Node_Id) return Name_Id;
+
    --  Record to store properties
    type User_Property is
       record