translate: rework subtype conversion. Fix #2356

4 files changed, 160 insertions, 14 deletions

diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index acc5d6537..442203e8e 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -3416,6 +3416,16 @@ package body Trans.Chap3 is
       Copy_Bounds (M2Addr (Dest), M2Addr (Src), Obj_Type);
    end Copy_Bounds;
 
+   procedure Copy_Range_No_Length (Dest : Mnode; Src : Mnode) is
+   begin
+      New_Assign_Stmt (M2Lv (Range_To_Left (Dest)),
+                       M2E (Range_To_Left (Src)));
+      New_Assign_Stmt (M2Lv (Range_To_Right (Dest)),
+                       M2E (Range_To_Right (Src)));
+      New_Assign_Stmt (M2Lv (Range_To_Dir (Dest)),
+                       M2E (Range_To_Dir (Src)));
+   end Copy_Range_No_Length;
+
    procedure Translate_Object_Allocation
      (Res        : in out Mnode;
       Alloc_Kind : Allocation_Kind;
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index 53f9450f1..6952f9987 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -258,6 +258,8 @@ package Trans.Chap3 is
    procedure Copy_Bounds (Dest : O_Enode; Src : O_Enode; Obj_Type : Iir);
    procedure Copy_Bounds (Dest : Mnode; Src : Mnode; Obj_Type : Iir);
 
+   procedure Copy_Range_No_Length (Dest : Mnode; Src : Mnode);
+
    --  Allocate an object of type OBJ_TYPE and set RES.
    --  RES must be a stable access of type ortho_ptr_type.
    --  For an unconstrained array, BOUNDS is a pointer to the boundaries of
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 5e89bf6c4..b7bcf97a8 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -970,15 +970,138 @@ package body Trans.Chap7 is
       end;
    end Convert_To_Constrained;
 
+   procedure Copy_Check_Bounds_Inner (Bnd : Mnode;
+                                      Expr_Type : Iir;
+                                      Res_Bnd : Mnode;
+                                      Res_Type : Iir;
+                                      Failure_Label : O_Snode) is
+   begin
+      case Iir_Kinds_Composite_Type_Definition (Get_Kind (Res_Type)) is
+         when Iir_Kind_Array_Type_Definition =>
+            --  Unconstrained by definition.
+            raise Internal_Error;
+         when Iir_Kind_Array_Subtype_Definition =>
+            if Get_Index_Constraint_Flag (Res_Type) then
+               declare
+                  Expr_Indexes : constant Iir_Flist :=
+                    Get_Index_Subtype_List (Expr_Type);
+                  Rng : Mnode;
+                  Res_Rng : Mnode;
+               begin
+                  for I in 1 .. Get_Nbr_Elements (Expr_Indexes) loop
+                     Open_Temp;
+                     Rng := Chap3.Bounds_To_Range (Bnd, Expr_Type, I);
+                     Stabilize (Rng);
+                     Res_Rng := Chap3.Bounds_To_Range (Res_Bnd, Res_Type, I);
+                     Stabilize (Res_Rng);
+                     Gen_Exit_When
+                       (Failure_Label,
+                        New_Compare_Op (ON_Neq,
+                                        M2E (Chap3.Range_To_Length (Rng)),
+                                        M2E (Chap3.Range_To_Length (Res_Rng)),
+                                        Ghdl_Bool_Type));
+
+                     Chap3.Copy_Range_No_Length (Rng, Res_Rng);
+                     Close_Temp;
+                  end loop;
+               end;
+            end if;
+
+            declare
+               Expr_El_Type : constant Iir := Get_Element_Subtype (Expr_Type);
+               Res_El_Type : constant Iir := Get_Element_Subtype (Res_Type);
+            begin
+               if (Get_Kind (Expr_El_Type)
+                     not in Iir_Kinds_Composite_Type_Definition)
+               then
+                  return;
+               end if;
+
+               if Is_A_Derived_Type (Expr_El_Type, Res_El_Type) then
+                  return;
+               end if;
+
+               Copy_Check_Bounds_Inner
+                 (Chap3.Array_Bounds_To_Element_Bounds (Bnd, Expr_Type),
+                  Expr_El_Type,
+                  Chap3.Array_Bounds_To_Element_Bounds (Res_Bnd, Res_Type),
+                  Res_El_Type,
+                  Failure_Label);
+            end;
+         when Iir_Kind_Record_Type_Definition =>
+            --  Not derived by definition
+            raise Internal_Error;
+         when Iir_Kind_Record_Subtype_Definition =>
+            declare
+               Expr_Els : constant Iir_Flist :=
+                 Get_Elements_Declaration_List (Expr_Type);
+               Res_Els : constant Iir_Flist :=
+                 Get_Elements_Declaration_List (Res_Type);
+               Expr_El, Res_El : Iir;
+               Expr_El_Type, Res_El_Type : Iir;
+            begin
+               for I in Flist_First .. Flist_Last (Expr_Els) loop
+                  Expr_El := Get_Nth_Element (Expr_Els, I);
+                  Res_El := Get_Nth_Element (Res_Els, I);
+                  Expr_El_Type := Get_Type (Expr_El);
+                  Res_El_Type := Get_Type (Res_El);
+                  if Expr_El_Type /= Res_El_Type then
+                     Copy_Check_Bounds_Inner
+                       (Chap3.Record_Bounds_To_Element_Bounds
+                          (Bnd, Expr_El),
+                        Expr_El_Type,
+                        Chap3.Record_Bounds_To_Element_Bounds
+                          (Res_Bnd, Res_El),
+                        Res_El_Type,
+                        Failure_Label);
+                  end if;
+               end loop;
+            end;
+      end case;
+   end Copy_Check_Bounds_Inner;
+
+   --  Perform a subtype conversions on bounds.
+   --  BND are the bounds of the results and can be modified (it's a copy).
+   --  EXPR_TYPE is the composite type whose bounds are described by BND.
+   --  RES_TYPE is the composite type of the result (partially constrained),
+   --  while RES_BND are the bounds of the composite type.
+   procedure Copy_Check_Bounds
+     (Bnd : Mnode; Expr_Type : Iir; Res_Bnd : Mnode; Res_Type : Iir; Loc : Iir)
+   is
+      Success_Label : O_Snode;
+      Failure_Label : O_Snode;
+   begin
+      --  If ATYPE is a parent type of EXPR_TYPE, then all the constrained
+      --  are inherited and there is nothing to check.
+      if Is_A_Derived_Type (Expr_Type, Res_Type) then
+         return;
+      end if;
+
+      Open_Temp;
+      --  Check each dimension.
+      Start_Loop_Stmt (Success_Label);
+      Start_Loop_Stmt (Failure_Label);
+
+      Copy_Check_Bounds_Inner
+        (Bnd, Expr_Type, Res_Bnd, Res_Type, Failure_Label);
+
+      New_Exit_Stmt (Success_Label);
+
+      Finish_Loop_Stmt (Failure_Label);
+      Chap6.Gen_Bound_Error (Loc);
+      Finish_Loop_Stmt (Success_Label);
+      Close_Temp;
+   end Copy_Check_Bounds;
+
    function Convert_To_Partially_Constrained
-     (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir) return Mnode
+     (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return Mnode
    is
       Res_Tinfo : constant Type_Info_Acc := Get_Info (Res_Type);
       Kind : constant Object_Kind_Type := Get_Object_Kind (Expr);
       Stable_Expr : Mnode;
       Res  : Mnode;
       Bnd : Mnode;
---      Res_Bnd : Mnode;
+      Res_Bnd : Mnode;
       Expr_Bnd : Mnode;
    begin
       if Is_A_Derived_Type (Expr_Type, Res_Type) then
@@ -1010,21 +1133,21 @@ package body Trans.Chap7 is
                                        Ghdl_Index_Type)));
 
       --  Copy/check bounds.
---      Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type);
---      Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type);
+      Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type);
+      Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type, Loc);
 
       return Res;
    end Convert_To_Partially_Constrained;
 
    function Convert_Constrained_To_Partially_Constrained
-     (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir) return Mnode
+     (Expr : Mnode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return Mnode
    is
       Res_Tinfo : constant Type_Info_Acc := Get_Info (Res_Type);
       Kind : constant Object_Kind_Type := Get_Object_Kind (Expr);
       Stable_Expr : Mnode;
       Res  : Mnode;
       Bnd : Mnode;
---      Res_Bnd : Mnode;
+      Res_Bnd : Mnode;
       Expr_Bnd : Mnode;
    begin
       Stable_Expr := Stabilize (Expr);
@@ -1058,8 +1181,8 @@ package body Trans.Chap7 is
                                           Ghdl_Index_Type)));
 
          --  Copy/check bounds.
-         --      Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type);
-         --      Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type);
+         Res_Bnd := Chap3.Get_Composite_Type_Bounds (Res_Type);
+         Copy_Check_Bounds (Bnd, Expr_Type, Res_Bnd, Res_Type, Loc);
       end if;
       return Res;
    end Convert_Constrained_To_Partially_Constrained;
@@ -1116,7 +1239,7 @@ package body Trans.Chap7 is
                when Unconstrained
                  | Partially_Constrained =>
                   return Convert_Constrained_To_Partially_Constrained
-                    (Expr, Expr_Type, Res_Type);
+                    (Expr, Expr_Type, Res_Type, Loc);
             end case;
          when Partially_Constrained
            | Unconstrained =>
@@ -1127,7 +1250,7 @@ package body Trans.Chap7 is
                   return Expr;
                when Partially_Constrained =>
                   return Convert_To_Partially_Constrained
-                    (Expr, Expr_Type, Res_Type);
+                    (Expr, Expr_Type, Res_Type, Loc);
                when Fully_Constrained =>
                   return Convert_To_Constrained
                     (Expr, Expr_Type, Res_Type, Loc);
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 9166d1e36..3d38b09fb 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -4593,19 +4593,29 @@ package body Trans.Chap8 is
 
       Target_Tinfo : Type_Info_Acc;
       Bounds : Mnode;
+      Layout : Mnode;
+      Constrained : Boolean;
    begin
       if Get_Kind (Target) = Iir_Kind_Aggregate then
          --  The target is an aggregate.
-         Chap3.Translate_Anonymous_Subtype_Definition (Target_Type, True);
+         Constrained := Get_Constraint_State (Target_Type) = Fully_Constrained;
+         Chap3.Translate_Anonymous_Subtype_Definition
+           (Target_Type, Constrained);
          Target_Tinfo := Get_Info (Target_Type);
          Targ := Create_Temp (Target_Tinfo, Mode_Signal);
          if Target_Tinfo.Type_Mode in Type_Mode_Unbounded then
+            pragma Assert (not Constrained);
             --  Unbounded array, allocate bounds.
-            Bounds := Dv2M (Create_Temp (Target_Tinfo.B.Bounds_Type),
+            pragma Assert (Target_Tinfo.S.Composite_Layout = Null_Var);
+            Target_Tinfo.S.Composite_Layout :=
+              Create_Var (Create_Uniq_Identifier, Target_Tinfo.B.Layout_Type,
+                          O_Storage_Local);
+            Layout := Lv2M (Get_Var (Target_Tinfo.S.Composite_Layout),
                             Target_Tinfo,
                             Mode_Value,
-                            Target_Tinfo.B.Bounds_Type,
-                            Target_Tinfo.B.Bounds_Ptr_Type);
+                            Target_Tinfo.B.Layout_Type,
+                            Target_Tinfo.B.Layout_Ptr_Type);
+            Bounds := Stabilize (Chap3.Layout_To_Bounds (Layout));
             New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Targ)),
                              M2Addr (Bounds));
             --  Build bounds from aggregate.
@@ -4615,6 +4625,7 @@ package body Trans.Chap8 is
             Translate_Signal_Target_Aggr
               (Chap3.Get_Composite_Base (Targ), Target, Target_Type);
          else
+            pragma Assert (Constrained);
             Chap4.Allocate_Complex_Object (Target_Type, Alloc_Stack, Targ);
             Translate_Signal_Target_Aggr (Targ, Target, Target_Type);
          end if;