sem_expr: add constraints to record aggregates.

Fix #646

3 files changed, 60 insertions, 8 deletions

diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 5ea510655..5e817ed9f 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -3042,6 +3042,10 @@ package body Sem_Expr is
       Has_Named : Boolean;
       Rec_El_Index : Natural;
       Expr_Staticness : Iir_Staticness;
+
+      --  True if at least one element constrains the subtype.  For unbounded
+      --  records.
+      Add_Constraints : Boolean;
    begin
       --  Not yet handled.
       Set_Aggregate_Expand_Flag (Aggr, False);
@@ -3050,6 +3054,7 @@ package body Sem_Expr is
       Assoc_Chain := Get_Association_Choices_Chain (Aggr);
       Matches := (others => Null_Iir);
       Expr_Staticness := Locally;
+      Add_Constraints := False;
 
       El_Type := Null_Iir;
       Has_Named := False;
@@ -3116,11 +3121,18 @@ package body Sem_Expr is
          --  Analyze the expression associated.
          if not Get_Same_Alternative_Flag (El) then
             if El_Type /= Null_Iir then
+               --  Analyze the expression only if the choice is correct.
                Expr := Sem_Expression (Expr, El_Type);
                if Expr /= Null_Iir then
                   Set_Associated_Expr (El, Eval_Expr_If_Static (Expr));
                   Expr_Staticness := Min (Expr_Staticness,
                                           Get_Expr_Staticness (Expr));
+                  if not Add_Constraints
+                    and then Is_Fully_Constrained_Type (Get_Type (Expr))
+                    and then not Is_Fully_Constrained_Type (El_Type)
+                  then
+                     Add_Constraints := True;
+                  end if;
                else
                   Ok := False;
                end if;
@@ -3151,6 +3163,42 @@ package body Sem_Expr is
       end loop;
       Set_Expr_Staticness (Aggr, Min (Get_Expr_Staticness (Aggr),
                                       Expr_Staticness));
+
+      if Ok and Add_Constraints then
+         declare
+            Rec_Type : Iir;
+            Rec_El_List : Iir_Flist;
+            Rec_El : Iir;
+            Rec_El_Type : Iir;
+            Constraint : Iir_Constraint;
+            Staticness : Iir_Staticness;
+         begin
+            Rec_Type := Sem_Types.Copy_Subtype_Indication (Get_Type (Aggr));
+            Rec_El_List := Get_Elements_Declaration_List (Rec_Type);
+            Constraint := Fully_Constrained;
+            Staticness := Locally;
+            for I in Flist_First .. Flist_Last (El_List) loop
+               El := Matches (I);
+               El_Type := Get_Type (Get_Associated_Expr (El));
+               Rec_El := Get_Nth_Element (Rec_El_List, I);
+               Rec_El_Type := Get_Type (Rec_El);
+               if Is_Fully_Constrained_Type (El_Type)
+                 and then not Is_Fully_Constrained_Type (Rec_El_Type)
+               then
+                  Rec_El_Type := El_Type;
+                  Set_Type (Rec_El, Rec_El_Type);
+               end if;
+               Staticness := Min (Staticness,
+                                  Get_Type_Staticness (Rec_El_Type));
+               Constraint := Sem_Types.Update_Record_Constraint (Constraint,
+                                                                 Rec_El_Type);
+            end loop;
+            Set_Type_Staticness (Rec_Type, Staticness);
+            Set_Constraint_State (Rec_Type, Constraint);
+            Set_Type (Aggr, Rec_Type);
+         end;
+      end if;
+
       return Ok;
    end Sem_Record_Aggregate;
 
diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb
index a38ae68a2..1018e8a8d 100644
--- a/src/vhdl/sem_types.adb
+++ b/src/vhdl/sem_types.adb
@@ -727,18 +727,18 @@ package body Sem_Types is
 
    --  Return the constraint state from CONST (the initial state) and EL_TYPE,
    --  as if ATYPE was a new element of a record.
-   function Update_Record_Constraint (Const : Iir_Constraint; El_Type : Iir)
-                                     return Iir_Constraint is
+   function Update_Record_Constraint
+     (Constraint : Iir_Constraint; El_Type : Iir) return Iir_Constraint is
    begin
       if Get_Kind (El_Type) not in Iir_Kinds_Composite_Type_Definition then
-         return Const;
+         return Constraint;
       end if;
 
-      case Const is
+      case Constraint is
          when Fully_Constrained
            | Unconstrained =>
-            if Get_Constraint_State (El_Type) = Const then
-               return Const;
+            if Get_Constraint_State (El_Type) = Constraint then
+               return Constraint;
             else
                return Partially_Constrained;
             end if;
@@ -1392,8 +1392,7 @@ package body Sem_Types is
    --  Analyze the constraint DEF + RESOLUTION for type TYPE_MARK.  The
    --  result is always a subtype definition.
    function Sem_Subtype_Constraint
-     (Def : Iir; Type_Mark : Iir; Resolution : Iir)
-     return Iir;
+     (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir;
 
    function Copy_Record_Element_Declaration (El : Iir; Parent : Iir) return Iir
    is
diff --git a/src/vhdl/sem_types.ads b/src/vhdl/sem_types.ads
index 827af5ffa..715a1199b 100644
--- a/src/vhdl/sem_types.ads
+++ b/src/vhdl/sem_types.ads
@@ -56,6 +56,11 @@ package Sem_Types is
    --  none.
    function Copy_Resolution_Indication (Subdef : Iir) return Iir;
 
+   --  Return the constraint state from CONST (the initial state) and EL_TYPE,
+   --  as if ATYPE was a new element of a record.
+   function Update_Record_Constraint
+     (Constraint : Iir_Constraint; El_Type : Iir) return Iir_Constraint;
+
    --  Although a nature is not a type, it is patterned like a type.
    function Sem_Subnature_Indication (Def: Iir) return Iir;
 end Sem_Types;