diff options
| -rw-r--r-- | src/vhdl/sem_expr.adb | 48 | ||||
| -rw-r--r-- | src/vhdl/sem_types.adb | 15 | ||||
| -rw-r--r-- | src/vhdl/sem_types.ads | 5 |
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; |