From e2a12a0150098fb8bd322096181bc83b18383fdb Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Thu, 14 May 2020 19:09:37 +0200
Subject: synth-aggr: create constrained record type if needed.

---
 src/synth/synth-aggr.adb     | 34 ++++++++++++++++++++++++++--------
 src/synth/synth-objtypes.ads |  2 ++
 2 files changed, 28 insertions(+), 8 deletions(-)

diff --git a/src/synth/synth-aggr.adb b/src/synth/synth-aggr.adb
index 0437bb3fb..cee38bea2 100644
--- a/src/synth/synth-aggr.adb
+++ b/src/synth/synth-aggr.adb
@@ -438,6 +438,7 @@ package body Synth.Aggr is
    is
       Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
       Tab_Res : Valtyp_Array_Acc;
+      Res_Typ : Type_Acc;
       Res : Valtyp;
       Err_P : Boolean;
       Const_P : Boolean;
@@ -451,15 +452,32 @@ package body Synth.Aggr is
 
       if Err_P then
          Res := No_Valtyp;
-      elsif Const_P then
-         Res := Create_Value_Memory (Aggr_Type);
-         for I in Aggr_Type.Rec.E'Range loop
-            Write_Value (Res.Val.Mem + Aggr_Type.Rec.E (I).Moff,
-                         Tab_Res (Tab_Res'Last - Nat32 (I) + 1));
-         end loop;
       else
-         Res := Create_Value_Net
-           (Valtyp_Array_To_Net (Ctxt, Tab_Res.all), Aggr_Type);
+         case Type_Records (Aggr_Type.Kind) is
+            when Type_Unbounded_Record =>
+               declare
+                  Els_Typ : Rec_El_Array_Acc;
+               begin
+                  Els_Typ := Create_Rec_El_Array (Aggr_Type.Rec.Len);
+                  for I in Els_Typ.E'Range loop
+                     Els_Typ.E (I).Typ := Tab_Res (Nat32 (I)).Typ;
+                  end loop;
+                  Res_Typ := Create_Record_Type (Els_Typ);
+               end;
+            when Type_Record =>
+               Res_Typ := Aggr_Type;
+         end case;
+
+         if Const_P then
+            Res := Create_Value_Memory (Res_Typ);
+            for I in Aggr_Type.Rec.E'Range loop
+               Write_Value (Res.Val.Mem + Aggr_Type.Rec.E (I).Moff,
+                            Tab_Res (Tab_Res'Last - Nat32 (I) + 1));
+            end loop;
+         else
+            Res := Create_Value_Net
+              (Valtyp_Array_To_Net (Ctxt, Tab_Res.all), Res_Typ);
+         end if;
       end if;
 
       Free_Valtyp_Array (Tab_Res);
diff --git a/src/synth/synth-objtypes.ads b/src/synth/synth-objtypes.ads
index 8824eea18..c0c2a1409 100644
--- a/src/synth/synth-objtypes.ads
+++ b/src/synth/synth-objtypes.ads
@@ -87,6 +87,8 @@ package Synth.Objtypes is
 
    subtype Type_Nets is Type_Kind range Type_Bit .. Type_Logic;
    subtype Type_All_Discrete is Type_Kind range Type_Bit .. Type_Discrete;
+   subtype Type_Records is
+     Type_Kind range Type_Unbounded_Record .. Type_Record;
 
    type Type_Type (Kind : Type_Kind);
    type Type_Acc is access Type_Type;
-- 
cgit v1.2.3