vhdl08: unbounded records (WIP - individual association)

4 files changed, 77 insertions, 12 deletions

diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 2eae9d2db..c6735cc0a 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -1770,6 +1770,8 @@ package Iirs is
    --   Get/Set_Type (Field1)
    --
    --   Get/Set_Element_Declaration (Field5)
+   --   Corresponding element_declaration.  FIXME: remove as supersided by
+   --   element_position.
    --
    --   Get/Set_Identifier (Field3)
    --
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index d760101e7..adb57e112 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -957,13 +957,13 @@ package body Sem_Assocs is
 
    procedure Finish_Individual_Assoc_Record (Assoc : Iir; Atype : Iir)
    is
-      Base_Type : constant Iir_Record_Type_Definition := Get_Base_Type (Atype);
-      El_List : constant Iir_List := Get_Elements_Declaration_List (Base_Type);
+      El_List : constant Iir_List := Get_Elements_Declaration_List (Atype);
       Matches : Iir_Array (0 .. Get_Nbr_Elements (El_List) - 1);
       Ch : Iir;
       Pos : Natural;
       Rec_El : Iir;
    begin
+      --  Check for duplicate associations.
       Matches := (others => Null_Iir);
       Ch := Get_Individual_Association_Chain (Assoc);
       while Ch /= Null_Iir loop
@@ -977,13 +977,71 @@ package body Sem_Assocs is
          end if;
          Ch := Get_Chain (Ch);
       end loop;
+
+      --  Check for missing associations.
       for I in Matches'Range loop
          Rec_El := Get_Nth_Element (El_List, I);
          if Matches (I) = Null_Iir then
             Error_Msg_Sem (+Assoc, "%n not associated", +Rec_El);
          end if;
       end loop;
-      Set_Actual_Type (Assoc, Atype);
+
+      if Get_Constraint_State (Atype) /= Fully_Constrained then
+         --  Some (sub-)elements are unbounded, create a bounded subtype.
+         declare
+            Ntype : Iir;
+            Nel_List : Iir_List;
+            Nrec_El : Iir;
+            Rec_El_Type : Iir;
+            Staticness : Iir_Staticness;
+         begin
+            Ntype := Create_Iir (Iir_Kind_Record_Subtype_Definition);
+            Location_Copy (Ntype, Assoc);
+            Set_Base_Type (Ntype, Get_Base_Type (Atype));
+            if Get_Kind (Atype) = Iir_Kind_Record_Subtype_Definition then
+               Set_Resolution_Indication
+                 (Ntype, Get_Resolution_Indication (Atype));
+            end if;
+            Nel_List := Create_Iir_List;
+            Set_Elements_Declaration_List (Ntype, Nel_List);
+
+            Staticness := Locally;
+            for I in Matches'Range loop
+               Rec_El := Get_Nth_Element (El_List, I);
+               Rec_El_Type := Get_Type (Rec_El);
+               if (Get_Kind (Rec_El_Type)
+                     not in Iir_Kinds_Composite_Type_Definition)
+                 or else
+                 Get_Constraint_State (Rec_El_Type) = Fully_Constrained
+                 or else
+                 Matches (I) = Null_Iir  --  In case of error.
+               then
+                  Nrec_El := Rec_El;
+               else
+                  Nrec_El := Create_Iir (Iir_Kind_Record_Element_Constraint);
+                  Ch := Matches (I);
+                  Location_Copy (Nrec_El, Ch);
+                  Set_Parent (Nrec_El, Ntype);
+                  Set_Identifier (Nrec_El, Get_Identifier (Rec_El));
+                  Set_Base_Element_Declaration
+                    (Nrec_El, Get_Base_Element_Declaration (Rec_El));
+                  Set_Element_Position
+                    (Nrec_El, Get_Element_Position (Rec_El));
+                  Ch := Get_Associated_Expr (Ch);
+                  Set_Type (Nrec_El, Get_Type (Get_Actual (Ch)));
+               end if;
+               Staticness := Min (Staticness,
+                                  Get_Type_Staticness (Get_Type (Nrec_El)));
+               Append_Element (Nel_List, Nrec_El);
+            end loop;
+            Set_Type_Staticness (Ntype, Staticness);
+            Set_Constraint_State (Ntype, Fully_Constrained);
+
+            Set_Actual_Type (Assoc, Ntype);
+         end;
+      else
+         Set_Actual_Type (Assoc, Atype);
+      end if;
    end Finish_Individual_Assoc_Record;
 
    --  Free recursively all the choices of ASSOC.
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 969be57ad..0cfaecd71 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -1182,16 +1182,14 @@ package body Trans.Chap3 is
 
    procedure Translate_Record_Subtype (Def : Iir; With_Vars : Boolean)
    is
-      Type_Mark  : constant Iir := Get_Type
-        (Get_Named_Entity (Get_Subtype_Type_Mark (Def)));
       Base_Type  : constant Iir := Get_Base_Type (Def);
-      Type_Mark_Info : constant Type_Info_Acc := Get_Info (Type_Mark);
+      Base_Info  : constant Type_Info_Acc := Get_Info (Base_Type);
       Info       : constant Type_Info_Acc := Get_Info (Def);
       El_List    : constant Iir_List := Get_Elements_Declaration_List (Def);
-      El_Tm_List   : constant Iir_List :=
-        Get_Elements_Declaration_List (Type_Mark);
+      Type_Mark  : constant Iir := Get_Subtype_Type_Mark (Def);
       El_Blist   : constant Iir_List :=
         Get_Elements_Declaration_List (Base_Type);
+      El_Tm_List : Iir_List;
       El, B_El   : Iir_Element_Declaration;
       El_Type    : Iir;
       El_Btype   : Iir;
@@ -1206,6 +1204,13 @@ package body Trans.Chap3 is
       Mark : Id_Mark_Type;
    begin
       --  Translate the newly constrained elements.
+      if Is_Valid (Type_Mark) then
+         --  Type_mark may be null for anonymous subtype.
+         El_Tm_List := Get_Elements_Declaration_List
+           (Get_Type (Get_Named_Entity (Type_Mark)));
+      else
+         El_Tm_List := El_Blist;
+      end if;
       Has_New_Constraints := False;
       for I in Natural loop
          El := Get_Nth_Element (El_List, I);
@@ -1222,8 +1227,8 @@ package body Trans.Chap3 is
          end if;
       end loop;
 
-      --  By default, use the same representation as the type mark.
-      Info.all := Type_Mark_Info.all;
+      --  By default, use the same representation as the base type.
+      Info.all := Base_Info.all;
       Info.S := Ortho_Info_Subtype_Record_Init;
       --  However, it is a different subtype which has its own rti.
       Info.Type_Rti := O_Dnode_Null;
@@ -1242,7 +1247,7 @@ package body Trans.Chap3 is
       Info.Type_Mode := Type_Mode_Record;
 
       --  Base type is complex (unbounded record)
-      Copy_Complex_Type (Info, Type_Mark_Info);
+      Copy_Complex_Type (Info, Base_Info);
 
       --  Then create the record type.
       if Get_Type_Staticness (Def) = Locally then
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index 2768e6ccd..44f31e9dd 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -671,7 +671,7 @@ package body Trans.Chap5 is
             Set_Map_Env (Formal_Env);
             --  Set bounds of unconstrained ports.
             if Get_Whole_Association_Flag (Assoc)
-              and then Fbt_Info.Type_Mode = Type_Mode_Fat_Array
+              and then Fbt_Info.Type_Mode in Type_Mode_Unbounded
             then
                Open_Temp;
                Elab_Unconstrained_Port_Bounds (Formal, Assoc);