aggregates (2008): support array expression

Fix #643

3 files changed, 32 insertions, 17 deletions

diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 47b7cf2cc..fdc34ebcd 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -537,6 +537,16 @@ package Iirs is
    --  field can be used to display the choices in the original order.
    --   Get/Set_Choice_Position (Field1)
    --
+   --  Should be a simple_name.
+   -- Only for Iir_Kind_Choice_By_Name:
+   --   Get/Set_Choice_Name (Field5)
+   --
+   -- Only for Iir_Kind_Choice_By_Expression:
+   --   Get/Set_Choice_Expression (Field5)
+   --
+   -- Only for Iir_Kind_Choice_By_Range:
+   --   Get/Set_Choice_Range (Field5)
+   --
    --  Get/Set what is associated with the choice.  There are two different
    --  nodes, one for simple association and the other for chain association.
    --  They don't have the same properties (normal vs chain), so the right
@@ -555,16 +565,6 @@ package Iirs is
    --  * a sequential statement chain for a case_statement.
    --   Get/Set_Associated_Chain (Field4)
    --
-   --  Should be a simple_name.
-   -- Only for Iir_Kind_Choice_By_Name:
-   --   Get/Set_Choice_Name (Field5)
-   --
-   -- Only for Iir_Kind_Choice_By_Expression:
-   --   Get/Set_Choice_Expression (Field5)
-   --
-   -- Only for Iir_Kind_Choice_By_Range:
-   --   Get/Set_Choice_Range (Field5)
-   --
    --   Get/Set_Same_Alternative_Flag (Flag1)
    --
    --   Get/Set_Element_Type_Flag (Flag2)
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index d2b199dde..a27da707c 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -2394,9 +2394,9 @@ package body Nodes_Meta is
       Field_Choice_Staticness,
       Field_Parent,
       Field_Chain,
+      Field_Choice_Range,
       Field_Associated_Expr,
       Field_Associated_Chain,
-      Field_Choice_Range,
       --  Iir_Kind_Choice_By_Expression
       Field_Choice_Position,
       Field_Same_Alternative_Flag,
@@ -2405,9 +2405,9 @@ package body Nodes_Meta is
       Field_Choice_Staticness,
       Field_Parent,
       Field_Chain,
+      Field_Choice_Expression,
       Field_Associated_Expr,
       Field_Associated_Chain,
-      Field_Choice_Expression,
       --  Iir_Kind_Choice_By_Others
       Field_Choice_Position,
       Field_Same_Alternative_Flag,
@@ -2433,9 +2433,9 @@ package body Nodes_Meta is
       Field_Element_Type_Flag,
       Field_Parent,
       Field_Chain,
+      Field_Choice_Name,
       Field_Associated_Expr,
       Field_Associated_Chain,
-      Field_Choice_Name,
       --  Iir_Kind_Entity_Aspect_Entity
       Field_Entity_Name,
       Field_Architecture,
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index e83cbfe04..1d385ab95 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -2934,12 +2934,27 @@ package body Trans.Chap7 is
       procedure Do_Assign (Assoc : Iir)
       is
          Expr : constant Iir := Get_Associated_Expr (Assoc);
+         Dest : Mnode;
+         Len : Iir_Int64;
       begin
          if Final then
-            Translate_Assign (Chap3.Index_Base (Base_Ptr, Aggr_Type,
-                                                New_Obj_Value (Var_Index)),
-                              Expr, Expr_Type);
-            Inc_Var (Var_Index);
+            if Get_Element_Type_Flag (Assoc) then
+               Dest := Chap3.Index_Base (Base_Ptr, Aggr_Type,
+                                         New_Obj_Value (Var_Index));
+               Translate_Assign (Dest, Expr, Expr_Type);
+               Inc_Var (Var_Index);
+            else
+               Dest := Chap3.Slice_Base (Base_Ptr, Aggr_Type,
+                                         New_Obj_Value (Var_Index));
+               Translate_Assign (Dest, Expr, Get_Type (Expr));
+               Len := Eval_Discrete_Type_Length
+                 (Get_Index_Type (Get_Type (Expr), 0));
+               New_Assign_Stmt
+                 (New_Obj (Var_Index),
+                  New_Dyadic_Op (ON_Add_Ov,
+                                 New_Obj_Value (Var_Index),
+                                 New_Lit (New_Index_Lit (Unsigned_64 (Len)))));
+            end if;
          else
             Translate_Array_Aggregate_Gen
               (Base_Ptr, Bounds_Ptr, Expr, Aggr_Type, Dim + 1, Var_Index);