vhdl/translate: check_composite_match: rename and handle records.

Fix #807

7 files changed, 211 insertions, 70 deletions

diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 4add8dd6e..04e410815 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -5068,6 +5068,10 @@ package Iirs is
    --Iir_Kind_Array_Subtype_Definition
      Iir_Kind_Record_Subtype_Definition;
 
+   subtype Iir_Kinds_Composite_Subtype_Definition is Iir_Kind range
+     Iir_Kind_Array_Subtype_Definition ..
+     Iir_Kind_Record_Subtype_Definition;
+
    subtype Iir_Kinds_Type_Declaration is Iir_Kind range
      Iir_Kind_Type_Declaration ..
    --Iir_Kind_Anonymous_Type_Declaration
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index a7985f6cd..7556f2b23 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -3422,7 +3422,10 @@ package body Trans.Chap3 is
       end if;
    end Maybe_Insert_Scalar_Check;
 
-   function Locally_Array_Match (L_Type, R_Type : Iir) return Boolean
+   function Locally_Types_Match (L_Type : Iir; R_Type : Iir)
+                                return Tri_State_Type;
+
+   function Locally_Array_Match (L_Type, R_Type : Iir) return Tri_State_Type
    is
       L_Indexes : constant Iir_Flist := Get_Index_Subtype_List (L_Type);
       R_Indexes : constant Iir_Flist := Get_Index_Subtype_List (R_Type);
@@ -3432,64 +3435,197 @@ package body Trans.Chap3 is
       for I in Flist_First .. Flist_Last (L_Indexes) loop
          L_El := Get_Index_Type (L_Indexes, I);
          R_El := Get_Index_Type (R_Indexes, I);
+         if Get_Type_Staticness (L_El) /= Locally
+           or else Get_Type_Staticness (R_El) /= Locally
+         then
+            return Unknown;
+         end if;
          if Eval_Discrete_Type_Length (L_El)
            /= Eval_Discrete_Type_Length (R_El)
          then
             return False;
          end if;
       end loop;
-      return True;
+      return Locally_Types_Match (Get_Element_Subtype (L_Type),
+                                  Get_Element_Subtype (R_Type));
    end Locally_Array_Match;
 
-   procedure Check_Array_Match (L_Type : Iir;
-                                L_Node : Mnode;
-                                R_Type : Iir;
-                                R_Node : Mnode;
-                                Loc    : Iir)
-   is
-      L_Tinfo : constant Type_Info_Acc := Get_Info (L_Type);
-      R_Tinfo : constant Type_Info_Acc := Get_Info (R_Type);
+   function Locally_Record_Match (L_Type : Iir; R_Type : Iir)
+                                 return Tri_State_Type
+   is
+      L_List : constant Iir_Flist := Get_Elements_Declaration_List (L_Type);
+      R_List : constant Iir_Flist := Get_Elements_Declaration_List (R_Type);
+      Res : Tri_State_Type;
+   begin
+      Res := True;
+      for I in Flist_First .. Flist_Last (L_List) loop
+         case Locally_Types_Match (Get_Type (Get_Nth_Element (L_List, I)),
+                                   Get_Type (Get_Nth_Element (R_List, I))) is
+            when False =>
+               return False;
+            when True =>
+               null;
+            when Unknown =>
+               Res := Unknown;
+         end case;
+      end loop;
+      return Res;
+   end Locally_Record_Match;
+
+   --  Return True IFF locally static types L_TYPE and R_TYPE matches.
+   function Locally_Types_Match (L_Type : Iir; R_Type : Iir)
+                                return Tri_State_Type is
    begin
-      if L_Tinfo.Type_Mode not in Type_Mode_Arrays then
-         return;
+      if L_Type = R_Type then
+         return True;
+      end if;
+      case Get_Kind (L_Type) is
+         when Iir_Kind_Array_Subtype_Definition =>
+            return Locally_Array_Match (L_Type, R_Type);
+         when Iir_Kind_Record_Subtype_Definition
+           | Iir_Kind_Record_Type_Definition =>
+            return Locally_Record_Match (L_Type, R_Type);
+         when Iir_Kinds_Scalar_Type_And_Subtype_Definition =>
+            return True;
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Access_Subtype_Definition =>
+            return True;
+         when others =>
+            Error_Kind ("locally_types_match", L_Type);
+      end case;
+   end Locally_Types_Match;
+
+   function Types_Match (L_Type : Iir; R_Type : Iir) return Tri_State_Type is
+   begin
+      if Get_Kind (L_Type) not in Iir_Kinds_Composite_Type_Definition then
+         return True;
       end if;
-      --  FIXME: optimize for a statically bounded array of a complex type.
-      if L_Tinfo.Type_Mode in Type_Mode_Arrays
-        and then L_Tinfo.Type_Locally_Constrained
-        and then R_Tinfo.Type_Mode in Type_Mode_Arrays
-        and then R_Tinfo.Type_Locally_Constrained
+      if Get_Constraint_State (L_Type) /= Fully_Constrained
+        or else Get_Constraint_State (R_Type) /= Fully_Constrained
       then
-         --  Both left and right are thin array.
-         --  Check here the length are the same.
-         if not Locally_Array_Match (L_Type, R_Type) then
-            Chap6.Gen_Bound_Error (Loc);
-         end if;
-      else
-         --  Check length match.
-         declare
-            Index_List : constant Iir_Flist :=
-              Get_Index_Subtype_List (L_Type);
-            Cond       : O_Enode;
-            Sub_Cond   : O_Enode;
-         begin
-            for I in 1 .. Get_Nbr_Elements (Index_List) loop
-               Sub_Cond := New_Compare_Op
-                 (ON_Neq,
-                  M2E (Range_To_Length
-                    (Get_Array_Range (L_Node, L_Type, I))),
-                  M2E (Range_To_Length
-                    (Get_Array_Range (R_Node, R_Type, I))),
-                  Ghdl_Bool_Type);
-               if I = 1 then
-                  Cond := Sub_Cond;
+         --  If one of the type is not fully constrained, the check is dynamic.
+         return Unknown;
+      end if;
+      if L_Type = R_Type then
+         --  If the type is the same, they match (they are constrained).
+         return True;
+      end if;
+      --  We cannot use type staticness, as a record may not be locally static
+      --  because it has one scalar element with non-locally static bounds.
+      return Locally_Types_Match (L_Type, R_Type);
+   end Types_Match;
+
+   function Check_Match_Cond (L_Type : Iir;
+                              L_Bounds : Mnode;
+                              R_Type : Iir;
+                              R_Bounds : Mnode) return O_Enode is
+   begin
+      case Iir_Kinds_Composite_Type_Definition (Get_Kind (L_Type)) is
+         when Iir_Kinds_Array_Type_Definition =>
+            --  Check length match.
+            declare
+               Index_List : constant Iir_Flist :=
+                 Get_Index_Subtype_List (L_Type);
+               Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List);
+               L_El : constant Iir := Get_Element_Subtype (L_Type);
+               R_El : constant Iir := Get_Element_Subtype (R_Type);
+               El_Match : Tri_State_Type;
+               Cond       : O_Enode;
+               Sub_Cond   : O_Enode;
+               L_Bounds1 : Mnode;
+               R_Bounds1 : Mnode;
+            begin
+               --  FIXME: stabilize.
+               El_Match := Types_Match (L_El, R_El);
+               if El_Match = Unknown or Nbr_Dim > 1 then
+                  L_Bounds1 := Stabilize (L_Bounds);
+                  R_Bounds1 := Stabilize (R_Bounds);
                else
+                  L_Bounds1 := L_Bounds;
+                  R_Bounds1 := R_Bounds;
+               end if;
+
+               for I in 1 .. Nbr_Dim loop
+                  Sub_Cond := New_Compare_Op
+                    (ON_Neq,
+                     M2E (Range_To_Length
+                            (Bounds_To_Range (L_Bounds1, L_Type, I))),
+                     M2E (Range_To_Length
+                            (Bounds_To_Range (R_Bounds1, R_Type, I))),
+                     Ghdl_Bool_Type);
+                  if I = 1 then
+                     Cond := Sub_Cond;
+                  else
+                     Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond);
+                  end if;
+               end loop;
+               if El_Match = Unknown then
+                  Sub_Cond := Check_Match_Cond
+                    (L_El, Array_Bounds_To_Element_Bounds (L_Bounds1, L_Type),
+                     R_El, Array_Bounds_To_Element_Bounds (R_Bounds1, R_Type));
                   Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond);
                end if;
-            end loop;
-            Chap6.Check_Bound_Error (Cond, Loc, 0);
-         end;
-      end if;
-   end Check_Array_Match;
+               return Cond;
+            end;
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Record_Subtype_Definition =>
+            declare
+               L_El_List : constant Iir_Flist :=
+                 Get_Elements_Declaration_List (L_Type);
+               R_El_List : constant Iir_Flist :=
+                 Get_Elements_Declaration_List (R_Type);
+               Cond : O_Enode;
+               Sub_Cond : O_Enode;
+            begin
+               Cond := O_Enode_Null;
+               for I in Flist_First .. Flist_Last (L_El_List) loop
+                  declare
+                     L_El : constant Iir := Get_Nth_Element (L_El_List, I);
+                     R_El : constant Iir := Get_Nth_Element (R_El_List, I);
+                     L_El_Type : constant Iir := Get_Type (L_El);
+                     R_El_Type : constant Iir := Get_Type (R_El);
+                  begin
+                     if Types_Match (L_El_Type, R_El_Type) = Unknown then
+                        Sub_Cond := Check_Match_Cond
+                          (L_El_Type,
+                           Record_Bounds_To_Element_Bounds (L_Bounds, L_El),
+                           R_El_Type,
+                           Record_Bounds_To_Element_Bounds (R_Bounds, R_El));
+                        if Cond = O_Enode_Null then
+                           Cond := Sub_Cond;
+                        else
+                           Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond);
+                        end if;
+                     end if;
+                  end;
+               end loop;
+               pragma Assert (Cond /= O_Enode_Null);
+               return Cond;
+            end;
+      end case;
+   end Check_Match_Cond;
+
+   procedure Check_Composite_Match (L_Type : Iir;
+                                    L_Node : Mnode;
+                                    R_Type : Iir;
+                                    R_Node : Mnode;
+                                    Loc    : Iir)
+   is
+      Res : O_Enode;
+   begin
+      case Types_Match (L_Type, R_Type) is
+         when True =>
+            return;
+         when False =>
+            --  FIXME: emit a warning ?
+            Chap6.Gen_Bound_Error (Loc);
+            return;
+         when Unknown =>
+            Res := Check_Match_Cond (L_Type, Get_Composite_Bounds (L_Node),
+                                     R_Type, Get_Composite_Bounds (R_Node));
+            Chap6.Check_Bound_Error (Res, Loc, 0);
+      end case;
+   end Check_Composite_Match;
 
    procedure Create_Range_From_Array_Attribute_And_Length
      (Array_Attr : Iir; Length : O_Dnode; Res : Mnode)
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index ceb255d58..754705533 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -317,15 +317,15 @@ package Trans.Chap3 is
      (Value : O_Enode; Expr : Iir; Atype : Iir) return O_Enode;
 
    --  Return True iff all indexes of L_TYPE and R_TYPE have the same
-   --  length.  They must be locally static.
-   function Locally_Array_Match (L_Type, R_Type : Iir) return Boolean;
+   --  length.  They must be constrained.
+   function Locally_Array_Match (L_Type, R_Type : Iir) return Tri_State_Type;
 
-   --  Check bounds length of L match bounds length of R.
-   --  If L_TYPE (resp. R_TYPE) is not a thin array, then L_NODE
+   --  Check bounds of L match bounds of R.
+   --  If L_TYPE (resp. R_TYPE) is not a thin composite type, then L_NODE
    --    (resp. R_NODE) are not used (and may be Mnode_Null).
-   --  If L_TYPE (resp. T_TYPE) is a fat array, then L_NODE (resp. R_NODE)
-   --    must designate the array.
-   procedure Check_Array_Match
+   --  If L_TYPE (resp. T_TYPE) is a fat type, then L_NODE (resp. R_NODE)
+   --    must designate the object.
+   procedure Check_Composite_Match
      (L_Type : Iir; L_Node : Mnode; R_Type : Iir; R_Node : Mnode; Loc : Iir);
 
    --  Create a subtype range to be stored into RES from length LENGTH, which
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 11c5f1a8c..cdd424cc9 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -1692,8 +1692,9 @@ package body Trans.Chap4 is
                   Stabilize (N);
                   New_Assign_Stmt (Get_Var (A),
                                    M2E (Chap3.Get_Composite_Base (N)));
-                  Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Mode),
-                                           Name_Type, N, Decl);
+                  Chap3.Check_Composite_Match
+                    (Decl_Type, T2M (Decl_Type, Mode),
+                     Name_Type, N, Decl);
                when Type_Mode_Acc
                  | Type_Mode_Bounds_Acc =>
                   New_Assign_Stmt (Get_Var (A), M2Addr (N));
@@ -1706,6 +1707,7 @@ package body Trans.Chap4 is
                   end case;
                when Type_Mode_Bounded_Records =>
                   Stabilize (N);
+                  --  FIXME: Check ?
                   New_Assign_Stmt (Get_Var (A), M2Addr (N));
                when others =>
                   raise Internal_Error;
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index cd02cf600..0b700189f 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -456,11 +456,12 @@ package body Trans.Chap5 is
 
          if Get_Kind (Formal_Type) in Iir_Kinds_Array_Type_Definition then
             --  Check length matches.
+            --  FIXME: records ?
             Stabilize (Formal_Sig);
             Stabilize (Actual_Sig);
-            Chap3.Check_Array_Match (Formal_Type, Formal_Sig,
-                                     Actual_Type, Actual_Sig,
-                                     Assoc);
+            Chap3.Check_Composite_Match (Formal_Type, Formal_Sig,
+                                         Actual_Type, Actual_Sig,
+                                         Assoc);
          end if;
 
          Data := (Actual_Sig => Actual_Sig,
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index e594ec45a..e34c6f378 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -77,7 +77,7 @@ package body Trans.Chap7 is
         and then Get_Constraint_State (Res_Type) = Fully_Constrained
       then
          --  constrained to constrained.
-         if not Chap3.Locally_Array_Match (Expr_Type, Res_Type) then
+         if Chap3.Locally_Array_Match (Expr_Type, Res_Type) /= True then
             --  Sem should have replaced the expression by an overflow.
             raise Internal_Error;
             --  Chap6.Gen_Bound_Error (Loc);
@@ -928,7 +928,7 @@ package body Trans.Chap7 is
             if Einfo.Type_Mode = Type_Mode_Static_Array then
                --  FIXME: optimize static vs non-static
                --  constrained to constrained.
-               if not Chap3.Locally_Array_Match (Expr_Type, Res_Type) then
+               if Chap3.Locally_Array_Match (Expr_Type, Res_Type) /= True then
                   --  FIXME: generate a bound error ?
                   --  Even if this is caught at compile-time,
                   --  the code is not required to run.
@@ -2769,7 +2769,8 @@ package body Trans.Chap7 is
            | Type_Mode_Bounds_Acc
            | Type_Mode_File =>
             New_Assign_Stmt (M2Lv (Target), Val);
-         when Type_Mode_Unbounded_Array =>
+         when Type_Mode_Unbounded_Array
+           | Type_Mode_Unbounded_Record =>
             declare
                T : Mnode;
                E : O_Dnode;
@@ -2779,7 +2780,7 @@ package body Trans.Chap7 is
                E := Create_Temp_Init
                  (T_Info.Ortho_Ptr_Type (Mode_Value), Val);
                EM := Dp2M (E, T_Info, Mode_Value);
-               Chap3.Check_Array_Match
+               Chap3.Check_Composite_Match
                  (Target_Type, T, Get_Type (Expr), EM, Loc);
                Chap3.Translate_Object_Copy (T, EM, Target_Type);
             end;
@@ -2789,9 +2790,6 @@ package body Trans.Chap7 is
             --  necessary.
             Chap3.Translate_Object_Copy
               (Target, E2M (Val, T_Info, Mode_Value), Target_Type);
-         when Type_Mode_Unbounded_Record =>
-            --  TODO
-            raise Internal_Error;
          when Type_Mode_Unknown
             | Type_Mode_Protected =>
             raise Internal_Error;
@@ -3886,7 +3884,7 @@ package body Trans.Chap7 is
       E := Stabilize (E2M (Expr, Expr_Info, Mode_Value));
       case Res_Info.Type_Mode is
          when Type_Mode_Bounded_Arrays =>
-            Chap3.Check_Array_Match
+            Chap3.Check_Composite_Match
               (Res_Type, T2M (Res_Type, Mode_Value),
                Expr_Type, E,
                Loc);
@@ -3899,7 +3897,7 @@ package body Trans.Chap7 is
             begin
                Res := Create_Temp (Res_Info);
                Copy_Fat_Pointer (Res, E);
-               Chap3.Check_Array_Match (Res_Type, Res, Expr_Type, E, Loc);
+               Chap3.Check_Composite_Match (Res_Type, Res, Expr_Type, E, Loc);
                return M2Addr (Res);
             end;
          when others =>
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index bf0e83fc8..31c6803b5 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -4304,7 +4304,7 @@ package body Trans.Chap8 is
       if Is_Composite (Target_Tinfo) then
          Stabilize (Val);
          Stabilize (Stable_Targ);
-         Chap3.Check_Array_Match
+         Chap3.Check_Composite_Match
            (Target_Type, Stable_Targ, Get_Type (We), Val, We);
       end if;
       Arg := (Drv => Drv,
@@ -4438,7 +4438,7 @@ package body Trans.Chap8 is
             then
                Stabilize (Targ2);
                Stabilize (Val);
-               Chap3.Check_Array_Match
+               Chap3.Check_Composite_Match
                  (Target_Type, Targ2, Get_Type (Value), Val, Wf_Chain);
             end if;
             Gen_Simple_Signal_Assign (Targ2, Target_Type, M2E (Val));
@@ -4500,7 +4500,7 @@ package body Trans.Chap8 is
                Translate_Waveform_Expression
                  (Value, Target_Type, Var_Targ, Val);
                Stabilize (Val);
-               Chap3.Check_Array_Match
+               Chap3.Check_Composite_Match
                  (Target_Type, Var_Targ, Get_Type (Value), Val, We);
             end if;
             Data := Signal_Assign_Data'(Expr => Val,
@@ -4532,7 +4532,7 @@ package body Trans.Chap8 is
                   Val := Chap7.Translate_Expression (Value, Target_Type);
                   if Is_Composite (Targ_Tinfo) then
                      Stabilize (Val);
-                     Chap3.Check_Array_Match
+                     Chap3.Check_Composite_Match
                        (Target_Type, Var_Targ, Get_Type (Value), Val, We);
                   end if;
                end if;