Update_Record_Constraint: fix initial state.

3 files changed, 33 insertions, 17 deletions

diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 60c2408d3..770b295d3 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -3171,11 +3171,13 @@ package body Sem_Expr is
             Rec_El : Iir;
             Rec_El_Type : Iir;
             Constraint : Iir_Constraint;
+            Composite_Found : Boolean;
             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;
+            Composite_Found := False;
             Staticness := Locally;
             for I in Flist_First .. Flist_Last (El_List) loop
                El := Matches (I);
@@ -3190,7 +3192,8 @@ package body Sem_Expr is
                end if;
                Staticness := Min (Staticness,
                                   Get_Type_Staticness (Rec_El_Type));
-               Sem_Types.Update_Record_Constraint (Constraint, Rec_El_Type);
+               Sem_Types.Update_Record_Constraint
+                 (Constraint, Composite_Found, Rec_El_Type);
             end loop;
             Set_Type_Staticness (Rec_Type, Staticness);
             Set_Constraint_State (Rec_Type, Constraint);
diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb
index ec802b31c..5cdcda8a4 100644
--- a/src/vhdl/sem_types.adb
+++ b/src/vhdl/sem_types.adb
@@ -739,22 +739,29 @@ package body Sem_Types is
    --  - [...]
    --  - It is a record subtype and each element subtype either is not a
    --    composite subtype or is a fully constrained composite subtype.
-   procedure Update_Record_Constraint
-     (Constraint : in out Iir_Constraint; El_Type : Iir) is
+   procedure Update_Record_Constraint (Constraint : in out Iir_Constraint;
+                                       Composite_Found : in out Boolean;
+                                       El_Type : Iir) is
    begin
       if Get_Kind (El_Type) not in Iir_Kinds_Composite_Type_Definition then
+         pragma Assert (Composite_Found or Constraint = Fully_Constrained);
          return;
       end if;
 
-      case Constraint is
-         when Fully_Constrained
-           | Unconstrained =>
-            if Get_Constraint_State (El_Type) /= Constraint then
+      if Composite_Found then
+         case Constraint is
+            when Fully_Constrained
+              | Unconstrained =>
+               if Get_Constraint_State (El_Type) /= Constraint then
+                  Constraint := Partially_Constrained;
+               end if;
+            when Partially_Constrained =>
                Constraint := Partially_Constrained;
-            end if;
-         when Partially_Constrained =>
-            Constraint := Partially_Constrained;
-      end case;
+         end case;
+      else
+         Composite_Found := True;
+         Constraint := Get_Constraint_State (El_Type);
+      end if;
    end Update_Record_Constraint;
 
    function Get_Array_Constraint (Def : Iir) return Iir_Constraint
@@ -847,6 +854,7 @@ package body Sem_Types is
       Resolved_Flag : Boolean;
       Type_Staticness : Iir_Staticness;
       Constraint : Iir_Constraint;
+      Composite_Found : Boolean;
    begin
       --  LRM 10.1
       --  5. A record type declaration,
@@ -856,6 +864,7 @@ package body Sem_Types is
       Last_Type := Null_Iir;
       Type_Staticness := Locally;
       Constraint := Fully_Constrained;
+      Composite_Found := False;
       Set_Signal_Type_Flag (Def, True);
 
       for I in Flist_First .. Flist_Last (El_List) loop
@@ -894,7 +903,7 @@ package body Sem_Types is
               Resolved_Flag and Get_Resolved_Flag (El_Type);
             Type_Staticness := Min (Type_Staticness,
                                     Get_Type_Staticness (El_Type));
-            Update_Record_Constraint (Constraint, El_Type);
+            Update_Record_Constraint (Constraint, Composite_Found, El_Type);
          else
             Type_Staticness := None;
          end if;
@@ -1970,6 +1979,7 @@ package body Sem_Types is
             Res_Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir);
             Pos : Natural;
             Constraint : Iir_Constraint;
+            Composite_Found : Boolean;
             Staticness : Iir_Staticness;
          begin
             --  Fill ELS with record constraints.
@@ -2052,6 +2062,7 @@ package body Sem_Types is
             El_List := Create_Iir_Flist (Nbr_Els);
             Set_Elements_Declaration_List (Res, El_List);
             Constraint := Fully_Constrained;
+            Composite_Found := False;
             Staticness := Locally;
             for I in Els'Range loop
                Tm_El := Get_Nth_Element (Tm_El_List, I);
@@ -2082,7 +2093,7 @@ package body Sem_Types is
                   Set_Element_Position (El, Get_Element_Position (Tm_El));
                end if;
                Set_Nth_Element (El_List, I, El);
-               Update_Record_Constraint (Constraint, El_Type);
+               Update_Record_Constraint (Constraint, Composite_Found, El_Type);
                Staticness := Min (Staticness, Get_Type_Staticness (El_Type));
             end loop;
             Set_Constraint_State (Res, Constraint);
diff --git a/src/vhdl/sem_types.ads b/src/vhdl/sem_types.ads
index 4fe6020af..f4ad3ff74 100644
--- a/src/vhdl/sem_types.ads
+++ b/src/vhdl/sem_types.ads
@@ -56,10 +56,12 @@ 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.
-   procedure Update_Record_Constraint
-     (Constraint : in out Iir_Constraint; El_Type : Iir);
+   --  Adjust the constraint state CONSTRAINT given new element EL_TYPE.
+   --  Initially CONSTRAINT must be Fully_Constrained and COMPOSITE_FOUND
+   --  must be false.
+   procedure Update_Record_Constraint (Constraint : in out Iir_Constraint;
+                                       Composite_Found : in out Boolean;
+                                       El_Type : Iir);
 
    --  Although a nature is not a type, it is patterned like a type.
    function Sem_Subnature_Indication (Def: Iir) return Iir;