sem: add force_constraints for aggregates.

3 files changed, 33 insertions, 12 deletions

diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index c75a78823..671d45ed5 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -3850,8 +3850,24 @@ package body Sem_Expr is
 
    --  Analyze aggregate EXPR whose type is expected to be A_TYPE.
    --  A_TYPE cannot be null_iir (this case is handled in sem_expression_ov)
-   function Sem_Aggregate (Expr: Iir_Aggregate; A_Type: Iir)
-                          return Iir_Aggregate is
+   --  If FORCE_CONSTRAINED is true, the aggregate type is constrained by the
+   --  context, even if its type isn't.  This is to deal with cases like:
+   --    procedure set (v : out string) is
+   --    begin
+   --      v := (others => ' ');
+   --    end set;
+   --  but this is not allowed by:
+   --  LRM08 9.3.3.3 Array aggregates
+   --  e) As a value expression in an assignment statement, where the target
+   --     is a declared object (or member thereof), and either the subtype of
+   --     the target is a fully constrained array subtype or the target is a
+   --     slice name.
+   function Sem_Aggregate
+     (Expr: Iir_Aggregate; A_Type: Iir; Force_Constrained : Boolean)
+     return Iir_Aggregate
+   is
+      Force_Constrained2 : constant Boolean :=
+        Force_Constrained and Flag_Relaxed_Rules;
    begin
       pragma Assert (A_Type /= Null_Iir);
 
@@ -3868,9 +3884,10 @@ package body Sem_Expr is
       case Get_Kind (A_Type) is
          when Iir_Kind_Array_Subtype_Definition =>
             return Sem_Array_Aggregate_Type
-              (Expr, A_Type, Get_Index_Constraint_Flag (A_Type));
+              (Expr, A_Type,
+               Force_Constrained2 or else Get_Index_Constraint_Flag (A_Type));
          when Iir_Kind_Array_Type_Definition =>
-            return Sem_Array_Aggregate_Type (Expr, A_Type, False);
+            return Sem_Array_Aggregate_Type (Expr, A_Type, Force_Constrained2);
          when Iir_Kind_Record_Type_Definition
            | Iir_Kind_Record_Subtype_Definition =>
             if not Sem_Record_Aggregate (Expr, A_Type) then
@@ -4491,7 +4508,7 @@ package body Sem_Expr is
             if A_Type = Null_Iir then
                return Expr;
             else
-               return Sem_Aggregate (Expr, A_Type);
+               return Sem_Aggregate (Expr, A_Type, False);
             end if;
 
          when Iir_Kind_Parenthesis_Expression =>
@@ -4671,7 +4688,9 @@ package body Sem_Expr is
       end if;
    end Compatible_Types_Intersect;
 
-   function Sem_Expression_Wildcard (Expr : Iir; Atype : Iir) return Iir
+   function Sem_Expression_Wildcard
+     (Expr : Iir; Atype : Iir; Force_Constrained : Boolean := False)
+     return Iir
    is
       Expr_Type : constant Iir := Get_Type (Expr);
       Atype_Defined : constant Boolean := Is_Defined_Type (Atype);
@@ -4692,7 +4711,7 @@ package body Sem_Expr is
       case Get_Kind (Expr) is
          when Iir_Kind_Aggregate =>
             if Atype_Defined then
-               return Sem_Aggregate (Expr, Atype);
+               return Sem_Aggregate (Expr, Atype, Force_Constrained);
             else
                pragma Assert (Expr_Type = Null_Iir);
                Set_Type (Expr, Wildcard_Any_Aggregate_Type);
@@ -4888,7 +4907,7 @@ package body Sem_Expr is
 
       case Get_Kind (Expr) is
          when Iir_Kind_Aggregate =>
-            Res := Sem_Aggregate (Expr, A_Type);
+            Res := Sem_Aggregate (Expr, A_Type, False);
          when Iir_Kind_String_Literal8 =>
             if A_Type = Null_Iir then
                Res := Sem_Expression_Ov (Expr, Null_Iir);
diff --git a/src/vhdl/sem_expr.ads b/src/vhdl/sem_expr.ads
index 15ae1da39..ab9718d65 100644
--- a/src/vhdl/sem_expr.ads
+++ b/src/vhdl/sem_expr.ads
@@ -261,7 +261,9 @@ package Sem_Expr is
    --  type), EXPR will be fully analyzed (possibly with an error).
    --  If EXPR is partially or fully analyzed, ATYPE must not be null_iir and
    --  it is checked with the types of EXPR.  EXPR may become fully analyzed.
-   function Sem_Expression_Wildcard (Expr : Iir; Atype : Iir) return Iir;
+   function Sem_Expression_Wildcard
+     (Expr : Iir; Atype : Iir; Force_Constrained : Boolean := False)
+     return Iir;
 
    --  To be used after Sem_Expression_Wildcard to update list ATYPE of
    --  possible types.
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index 1d33ad7fc..0f9f029dd 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -493,7 +493,7 @@ package body Sem_Stmts is
             --  sem_check_waveform_list.
             null;
          else
-            Expr := Sem_Expression_Wildcard (Expr, Waveform_Type);
+            Expr := Sem_Expression_Wildcard (Expr, Waveform_Type, True);
 
             if Expr /= Null_Iir then
                if Is_Expr_Fully_Analyzed (Expr) then
@@ -785,7 +785,7 @@ package body Sem_Stmts is
       El := Cond_Expr;
       while El /= Null_Iir loop
          Expr := Get_Expression (El);
-         Expr := Sem_Expression_Wildcard (Expr, Atype);
+         Expr := Sem_Expression_Wildcard (Expr, Atype, True);
 
          if Expr /= Null_Iir then
             Set_Expression (El, Expr);
@@ -850,7 +850,7 @@ package body Sem_Stmts is
          case Iir_Kinds_Variable_Assignment_Statement (Get_Kind (Stmt)) is
             when Iir_Kind_Variable_Assignment_Statement =>
                Expr := Get_Expression (Stmt);
-               Expr := Sem_Expression_Wildcard (Expr, Stmt_Type);
+               Expr := Sem_Expression_Wildcard (Expr, Stmt_Type, True);
                if Expr /= Null_Iir then
                   if Is_Expr_Fully_Analyzed (Expr) then
                      Check_Read (Expr);