synth: handle vhdl-08 ports. Fix ghdl/ghdl-yosys-plugin#111

3 files changed, 36 insertions, 16 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 378921c45..0e4674b01 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -290,6 +290,16 @@ package body Synth.Decls is
       end case;
    end Synth_Float_Range_Constraint;
 
+   function Has_Element_Subtype_Indication (Atype : Node) return Boolean is
+   begin
+      return Get_Array_Element_Constraint (Atype) /= Null_Node
+        or else
+        (Get_Resolution_Indication (Atype) /= Null_Node
+           and then
+           (Get_Kind (Get_Resolution_Indication (Atype))
+              = Iir_Kind_Array_Element_Resolution));
+   end Has_Element_Subtype_Indication;
+
    function Synth_Array_Subtype_Indication
      (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc
    is
@@ -302,13 +312,7 @@ package body Synth.Decls is
       Bnds : Bound_Array_Acc;
    begin
       --  VHDL08
-      if Get_Array_Element_Constraint (Atype) /= Null_Node
-        or else
-        (Get_Resolution_Indication (Atype) /= Null_Node
-           and then
-           (Get_Kind (Get_Resolution_Indication (Atype))
-              = Iir_Kind_Array_Element_Resolution))
-      then
+      if Has_Element_Subtype_Indication (Atype) then
          --  This subtype has created a new anonymous subtype for the
          --  element.
          Synth_Subtype_Indication (Syn_Inst, El_Type);
@@ -383,8 +387,7 @@ package body Synth.Decls is
                   Rng := Synth_Discrete_Range_Constraint
                     (Syn_Inst, Get_Range_Constraint (Atype));
                   W := Discrete_Range_Width (Rng);
-                  return
-                    Create_Discrete_Type (Rng, Btype.Sz, W);
+                  return Create_Discrete_Type (Rng, Btype.Sz, W);
                end if;
             end;
          when Iir_Kind_Floating_Subtype_Definition =>
diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads
index 68b7fea08..9aae21e2a 100644
--- a/src/synth/synth-decls.ads
+++ b/src/synth/synth-decls.ads
@@ -28,6 +28,9 @@ package Synth.Decls is
    --  subtype).
    function Get_Declaration_Type (Decl : Node) return Node;
 
+   --  True if the element subtype indication of ATYPE needs to be created.
+   function Has_Element_Subtype_Indication (Atype : Node) return Boolean;
+
    function Synth_Array_Subtype_Indication
      (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc;
 
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index ab6ef4133..72df81993 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -350,17 +350,31 @@ package body Synth.Insts is
       return New_Sname_User (Id, No_Sname);
    end Create_Inter_Name;
 
-   procedure Build_Object_Subtype (Syn_Inst : Synth_Instance_Acc;
-                                   Inter : Node;
-                                   Proto_Inst : Synth_Instance_Acc)
+   procedure Copy_Object_Subtype (Syn_Inst : Synth_Instance_Acc;
+                                  Inter_Type : Node;
+                                  Proto_Inst : Synth_Instance_Acc)
    is
-      Inter_Type : Node;
       Inter_Typ : Type_Acc;
    begin
+      case Get_Kind (Inter_Type) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            if Synth.Decls.Has_Element_Subtype_Indication (Inter_Type) then
+               Copy_Object_Subtype
+                 (Syn_Inst, Get_Element_Subtype (Inter_Type), Proto_Inst);
+            end if;
+         when others =>
+            null;
+      end case;
+      Inter_Typ := Get_Subtype_Object (Proto_Inst, Inter_Type);
+      Create_Subtype_Object (Syn_Inst, Inter_Type, Inter_Typ);
+   end Copy_Object_Subtype;
+
+   procedure Build_Object_Subtype (Syn_Inst : Synth_Instance_Acc;
+                                   Inter : Node;
+                                   Proto_Inst : Synth_Instance_Acc) is
+   begin
       if Get_Declaration_Type (Inter) /= Null_Node then
-         Inter_Type := Get_Type (Inter);
-         Inter_Typ := Get_Value (Proto_Inst, Inter).Typ;
-         Create_Subtype_Object (Syn_Inst, Inter_Type, Inter_Typ);
+         Copy_Object_Subtype (Syn_Inst, Get_Type (Inter), Proto_Inst);
       end if;
    end Build_Object_Subtype;