translate: handle unbounded aggregate for signal target.

Fix for #676.

4 files changed, 100 insertions, 15 deletions

diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 2d7a126a2..e10e2c2f2 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -3044,7 +3044,7 @@ package body Trans.Chap3 is
    function Slice_Base (Base : Mnode; Atype : Iir; Index : O_Enode)
                         return Mnode
    is
-      T_Info   : constant Type_Info_Acc :=  Get_Info (Atype);
+      T_Info   : constant Type_Info_Acc := Get_Info (Atype);
       El_Type  : constant Iir := Get_Element_Subtype (Atype);
       El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
       Kind     : constant Object_Kind_Type := Get_Object_Kind (Base);
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index fbee6e01d..4e2b46000 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -3453,6 +3453,72 @@ package body Trans.Chap7 is
       end case;
    end Translate_Aggregate;
 
+   procedure Translate_Aggregate_Bounds (Bounds : Mnode; Aggr : Iir)
+   is
+      Aggr_Type : constant Iir := Get_Type (Aggr);
+      Assoc : Iir;
+      Static_Len : Iir_Int64;
+      Var_Len : O_Dnode;
+      Expr_Type : Iir;
+      Range_Type : Iir;
+   begin
+      Static_Len := 0;
+
+      --  First pass: static length.
+      Assoc := Get_Association_Choices_Chain (Aggr);
+      while Assoc /= Null_Iir loop
+         pragma Assert (Get_Kind (Assoc) = Iir_Kind_Choice_By_None);
+         if Get_Element_Type_Flag (Assoc) then
+            Static_Len := Static_Len + 1;
+         else
+            Expr_Type := Get_Type (Get_Associated_Expr (Assoc));
+            pragma Assert (Is_One_Dimensional_Array_Type (Expr_Type));
+            if Get_Constraint_State (Expr_Type) = Fully_Constrained then
+               Range_Type := Get_Index_Type (Expr_Type, 0);
+               if Get_Type_Staticness (Range_Type) = Locally then
+                  Static_Len :=
+                    Static_Len + Eval_Discrete_Type_Length (Range_Type);
+               end if;
+            end if;
+         end if;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+
+      --  Second pass: non-static length.
+      Var_Len := Create_Temp (Ghdl_Index_Type);
+      New_Assign_Stmt (New_Obj (Var_Len),
+                       New_Lit (New_Index_Lit (Unsigned_64 (Static_Len))));
+      Assoc := Get_Association_Choices_Chain (Aggr);
+      while Assoc /= Null_Iir loop
+         pragma Assert (Get_Kind (Assoc) = Iir_Kind_Choice_By_None);
+         if not Get_Element_Type_Flag (Assoc) then
+            Expr_Type := Get_Type (Get_Associated_Expr (Assoc));
+            if Get_Constraint_State (Expr_Type) = Fully_Constrained then
+               Range_Type := Get_Index_Type (Expr_Type, 0);
+               if Get_Type_Staticness (Range_Type) /= Locally then
+                  declare
+                     Bnd : Mnode;
+                     L : Mnode;
+                  begin
+                     Bnd := Chap3.Get_Composite_Type_Bounds (Expr_Type);
+                     L := Chap3.Range_To_Length
+                       (Chap3.Bounds_To_Range (Bnd, Expr_Type, 1));
+                     New_Assign_Stmt
+                       (New_Obj (Var_Len),
+                        New_Dyadic_Op (ON_Add_Ov,
+                                       New_Obj_Value (Var_Len), M2E (L)));
+                  end;
+               end if;
+            end if;
+         end if;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+
+      Chap3.Create_Range_From_Length
+        (Get_Index_Type (Aggr_Type, 0), Var_Len,
+         Chap3.Bounds_To_Range (Bounds, Aggr_Type, 1), Aggr);
+   end Translate_Aggregate_Bounds;
+
    function Translate_Allocator_By_Expression (Expr : Iir) return O_Enode
    is
       A_Type : constant Iir := Get_Type (Expr);
diff --git a/src/vhdl/translate/trans-chap7.ads b/src/vhdl/translate/trans-chap7.ads
index 18b849de4..3c1acdefa 100644
--- a/src/vhdl/translate/trans-chap7.ads
+++ b/src/vhdl/translate/trans-chap7.ads
@@ -70,17 +70,16 @@ package Trans.Chap7 is
                                           return O_Cnode;
 
    --  Convert (if necessary) EXPR of type EXPR_TYPE to type ATYPE.
-   function Translate_Implicit_Conv
-     (Expr      : O_Enode;
-      Expr_Type : Iir;
-      Atype     : Iir;
-      Is_Sig    : Object_Kind_Type;
-      Loc       : Iir)
-         return O_Enode;
+   function Translate_Implicit_Conv (Expr      : O_Enode;
+                                     Expr_Type : Iir;
+                                     Atype     : Iir;
+                                     Is_Sig    : Object_Kind_Type;
+                                     Loc       : Iir)
+                                    return O_Enode;
 
    function Translate_Type_Conversion
      (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
-         return O_Enode;
+     return O_Enode;
 
    --  Convert bounds SRC (of type SRC_TYPE) to RES (of type RES_TYPE).
    procedure Translate_Type_Conversion_Bounds
@@ -115,6 +114,9 @@ package Trans.Chap7 is
    procedure Translate_Aggregate
      (Target : Mnode; Target_Type : Iir; Aggr : Iir);
 
+   --  Fill BOUNDS from aggregate AGGR.
+   procedure Translate_Aggregate_Bounds (Bounds : Mnode; Aggr : Iir);
+
    --  Convert bounds access PTR to a fat pointer.
    function Bounds_Acc_To_Fat_Pointer (Ptr : O_Dnode; Acc_Type : Iir)
                                       return Mnode;
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 7726c3719..8c34b6b7b 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -3987,9 +3987,9 @@ package body Trans.Chap8 is
                     (Aggr, Target_Type, New_Obj_Value (Idx));
                   Sub_Type := Get_Element_Subtype (Target_Type);
                else
-                  Sub_Aggr := Chap3.Slice_Base
-                    (Aggr, Target_Type, New_Obj_Value (Idx));
                   Sub_Type := Get_Type (Expr);
+                  Sub_Aggr := Chap3.Slice_Base
+                    (Aggr, Sub_Type, New_Obj_Value (Idx));
                end if;
             when others =>
                Error_Kind ("translate_signal_target_array_aggr", El);
@@ -4304,16 +4304,33 @@ package body Trans.Chap8 is
       Drv : out Mnode)
    is
       Target_Type : constant Iir := Get_Type (Target);
+
+      Target_Tinfo : Type_Info_Acc;
+      Bounds : Mnode;
    begin
       if Get_Kind (Target) = Iir_Kind_Aggregate then
          Chap3.Translate_Anonymous_Subtype_Definition (Target_Type, False);
-         Targ := Create_Temp (Get_Info (Target_Type), Mode_Signal);
-         if Get_Constraint_State (Target_Type) /= Fully_Constrained then
-            raise Internal_Error;
+         Target_Tinfo := Get_Info (Target_Type);
+         Targ := Create_Temp (Target_Tinfo, Mode_Signal);
+         if Target_Tinfo.Type_Mode in Type_Mode_Unbounded then
+            Bounds := Dv2M (Create_Temp (Target_Tinfo.B.Bounds_Type),
+                            Target_Tinfo,
+                            Mode_Value,
+                            Target_Tinfo.B.Bounds_Type,
+                            Target_Tinfo.B.Bounds_Ptr_Type);
+            New_Assign_Stmt
+              (M2Lp (Chap3.Get_Composite_Bounds (Targ)),
+               M2Addr (Bounds));
+            --  Build bounds from aggregate.
+            Chap7.Translate_Aggregate_Bounds (Bounds, Target);
+            Chap3.Allocate_Unbounded_Composite_Base
+              (Alloc_Stack, Targ, Target_Type);
+            Translate_Signal_Target_Aggr
+              (Chap3.Get_Composite_Base (Targ), Target, Target_Type);
          else
             Chap4.Allocate_Complex_Object (Target_Type, Alloc_Stack, Targ);
+            Translate_Signal_Target_Aggr (Targ, Target, Target_Type);
          end if;
-         Translate_Signal_Target_Aggr (Targ, Target, Target_Type);
       else
          if Mechanism = Signal_Assignment_Direct then
             Chap6.Translate_Direct_Driver (Target, Targ, Drv);