vhdl: add ghdl_integer_index_check_failed. For #1257

Improve error message in case of (integer) index not in bounds.

12 files changed, 157 insertions, 52 deletions

diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 1c247e7ae..e0e1d5dbc 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -328,6 +328,9 @@ package body Ghdlrun is
            Grt.Lib.Ghdl_Bound_Check_Failed'Address);
       Def (Trans_Decls.Ghdl_Direction_Check_Failed,
            Grt.Lib.Ghdl_Direction_Check_Failed'Address);
+      Def (Trans_Decls.Ghdl_Integer_Index_Check_Failed,
+           Grt.Lib.Ghdl_Integer_Index_Check_Failed'Address);
+
       Def (Trans_Decls.Ghdl_Malloc0,
            Grt.Lib.Ghdl_Malloc0'Address);
       Def (Trans_Decls.Ghdl_Std_Ulogic_To_Boolean_Array,
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb
index 653606a31..bc6ba2366 100644
--- a/src/grt/grt-lib.adb
+++ b/src/grt/grt-lib.adb
@@ -205,6 +205,38 @@ package body Grt.Lib is
       Error_E_Call_Stack (Bt);
    end Ghdl_Direction_Check_Failed;
 
+   procedure Diag_C_Range (Rng : Std_Integer_Range_Ptr) is
+   begin
+      Diag_C (Rng.Left);
+      case Rng.Dir is
+         when Dir_Downto =>
+            Diag_C (" downto ");
+         when Dir_To =>
+            Diag_C (" to ");
+      end case;
+      Diag_C (Rng.Right);
+   end Diag_C_Range;
+
+   procedure Ghdl_Integer_Index_Check_Failed
+     (Filename : Ghdl_C_String;
+      Line     : Ghdl_I32;
+      Val      : Std_Integer;
+      Rng      : Std_Integer_Range_Ptr)
+   is
+      Bt : Backtrace_Addrs;
+   begin
+      Save_Backtrace (Bt, 1);
+      Error_S ("index (");
+      Diag_C (Val);
+      Diag_C (") out of bounds (");
+      Diag_C_Range (Rng);
+      Diag_C (") at ");
+      Diag_C (Filename);
+      Diag_C (":");
+      Diag_C (Line);
+      Error_E_Call_Stack (Bt);
+   end Ghdl_Integer_Index_Check_Failed;
+
    function Hi (V : Ghdl_I64) return Ghdl_U32 is
    begin
       return Ghdl_U32 (Shift_Right (To_Ghdl_U64 (V), 32) and 16#ffff_ffff#);
diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads
index b0f68d3e9..6e65a3188 100644
--- a/src/grt/grt-lib.ads
+++ b/src/grt/grt-lib.ads
@@ -54,6 +54,12 @@ package Grt.Lib is
    procedure Ghdl_Direction_Check_Failed (Filename : Ghdl_C_String;
                                           Line: Ghdl_I32);
 
+   procedure Ghdl_Integer_Index_Check_Failed
+     (Filename : Ghdl_C_String;
+      Line     : Ghdl_I32;
+      Val      : Std_Integer;
+      Rng      : Std_Integer_Range_Ptr);
+
    --  Program error has occurred:
    --  * configuration of an already configured block.
    procedure Ghdl_Program_Error (Filename : Ghdl_C_String;
@@ -117,6 +123,9 @@ private
                   "__ghdl_bound_check_failed");
    pragma Export (C, Ghdl_Direction_Check_Failed,
                   "__ghdl_direction_check_failed");
+   pragma Export (C, Ghdl_Integer_Index_Check_Failed,
+                  "__ghdl_integer_index_check_failed");
+
    pragma Export (C, Ghdl_Program_Error, "__ghdl_program_error");
 
    pragma Export (C, Ghdl_Check_Stack_Allocation,
diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads
index 0aa6dcc79..e59a38313 100644
--- a/src/grt/grt-types.ads
+++ b/src/grt/grt-types.ads
@@ -72,6 +72,9 @@ package Grt.Types is
       Length : Ghdl_Index_Type;
    end record;
 
+   type Std_Integer_Range_Ptr is access Std_Integer_Trt;
+   pragma Convention (C, Std_Integer_Range_Ptr);
+
    subtype Std_Character is Character;
    type Std_String_Uncons is array (Ghdl_Index_Type range <>) of Std_Character;
    subtype Std_String_Base is Std_String_Uncons (Ghdl_Index_Type);
diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb
index 35a3152e2..ea2caf189 100644
--- a/src/vhdl/translate/trans-chap14.adb
+++ b/src/vhdl/translate/trans-chap14.adb
@@ -342,7 +342,7 @@ package body Trans.Chap14 is
                   New_Obj_Value (L),
                   New_Lit (Get_Ortho_Literal (Get_Nth_Element (List, Limit))),
                   Ghdl_Bool_Type),
-                  Attr, 0);
+                  Attr);
                return New_Convert_Ov
                  (New_Dyadic_Op
                     (Op,
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 88cc0d367..1f7472938 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -3562,7 +3562,7 @@ package body Trans.Chap3 is
          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);
+            Chap6.Check_Bound_Error (Res, Loc);
       end case;
    end Check_Composite_Match;
 
diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index 84cf1ffb6..e558cb726 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -20,6 +20,8 @@ with Files_Map;
 with Vhdl.Errors; use Vhdl.Errors;
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Evaluation; use Vhdl.Evaluation;
+with Vhdl.Std_Package;
+
 with Trans.Chap3;
 with Trans.Chap7;
 with Trans.Chap14;
@@ -95,9 +97,8 @@ package body Trans.Chap6 is
    --  index violation for dimension DIM of an array.  LOC is usually
    --  the expression which has computed the index and is used only for
    --  its location.
-   procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir; Dim : Natural)
+   procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir)
    is
-      pragma Unreferenced (Dim);
       If_Blk : O_If_Block;
    begin
       Start_If_Stmt (If_Blk, Cond);
@@ -193,6 +194,31 @@ package body Trans.Chap6 is
       end loop;
    end Get_Deep_Range_Expression;
 
+   --  Give a nice error message when the index is an integer
+   --  (with the bounds and the index).
+   --  This is a special case that would handle more than 95% of
+   --  the user cases.
+   procedure Check_Integer_Bound_Error
+     (Cond : O_Enode; Index : Mnode; Rng : Mnode; Loc : Iir)
+   is
+      If_Blk       : O_If_Block;
+      Constr       : O_Assoc_List;
+      Name         : Name_Id;
+      Line, Col    : Natural;
+   begin
+      Start_If_Stmt (If_Blk, Cond);
+
+      Files_Map.Location_To_Position  (Get_Location (Loc), Name, Line, Col);
+
+      Start_Association (Constr, Ghdl_Integer_Index_Check_Failed);
+      Assoc_Filename_Line (Constr, Line);
+      New_Association (Constr, M2E (Index));
+      New_Association (Constr, M2Addr (Rng));
+      New_Procedure_Call (Constr);
+
+      Finish_If_Stmt (If_Blk);
+   end Check_Integer_Bound_Error;
+
    function Translate_Index_To_Offset (Rng        : Mnode;
                                        Index      : Mnode;
                                        Index_Expr : Iir;
@@ -203,6 +229,8 @@ package body Trans.Chap6 is
       Range_Btype  : constant Iir := Get_Base_Type (Range_Type);
       Index_Tinfo  : constant Type_Info_Acc := Get_Info (Range_Btype);
       Index_Tnode  : constant O_Tnode := Index_Tinfo.Ortho_Type (Mode_Value);
+      Is_Integer   : constant Boolean :=
+        Range_Btype = Vhdl.Std_Package.Integer_Type_Definition;
       Index1       : Mnode;
       Need_Check   : Boolean;
       If_Blk       : O_If_Block;
@@ -268,7 +296,7 @@ package body Trans.Chap6 is
 
       --  Get the offset.
       New_Assign_Stmt
-        (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off), Ghdl_Index_Type));
+        (New_Obj (Res), New_Convert (New_Obj_Value (Off), Ghdl_Index_Type));
 
       --  Check bounds.
       if Need_Check then
@@ -288,7 +316,11 @@ package body Trans.Chap6 is
                M2E (Chap3.Range_To_Length (Rng)),
                Ghdl_Bool_Type);
             Cond := New_Dyadic_Op (ON_Or, Cond1, Cond2);
-            Check_Bound_Error (Cond, Loc, 0);
+            if Is_Integer then
+               Check_Integer_Bound_Error (Cond, Index1, Rng, Loc);
+            else
+               Check_Bound_Error (Cond, Loc);
+            end if;
          end;
       end if;
 
@@ -301,20 +333,23 @@ package body Trans.Chap6 is
    --  offset.
    --  This checks bounds.
    function Translate_Thin_Index_Offset
-     (Index_Type : Iir; Dim : Natural; Expr : Iir) return O_Enode
+     (Index_Type : Iir; Expr : Iir; Rng : Mnode) return O_Enode
    is
       Index_Range     : constant Iir := Get_Range_Constraint (Index_Type);
       Obound          : O_Cnode;
       Res             : O_Dnode;
       Cond2           : O_Enode;
-      Index           : O_Enode;
+      Index           : Mnode;
+      Off             : O_Enode;
       Index_Base_Type : Iir;
       V               : Int64;
       B               : Int64;
       Expr1 : Iir;
    begin
       B := Eval_Pos (Get_Left_Limit (Index_Range));
+
       if Get_Expr_Staticness (Expr) = Locally then
+         --  Both range and index are static.
          Expr1 := Eval_Static_Expr (Expr);
          if not Eval_Is_In_Bound (Expr1, Index_Type) then
             Gen_Bound_Error (Expr1);
@@ -328,42 +363,49 @@ package body Trans.Chap6 is
             B := B - V;
          end if;
          return New_Lit (New_Index_Lit (Unsigned_64 (B)));
-      else
-         Index_Base_Type := Get_Base_Type (Index_Type);
-         Index := Chap7.Translate_Expression (Expr, Index_Base_Type);
+      end if;
 
-         if Get_Direction (Index_Range) = Dir_To then
-            --  Direction TO:  INDEX - LEFT.
-            if B /= 0 then
-               Obound := Chap7.Translate_Static_Range_Left
-                 (Index_Range, Index_Base_Type);
-               Index := New_Dyadic_Op (ON_Sub_Ov, Index, New_Lit (Obound));
-            end if;
-         else
-            --  Direction DOWNTO:  LEFT - INDEX.
+      Index_Base_Type := Get_Base_Type (Index_Type);
+      Index := Chap7.Translate_Expression (Expr, Index_Base_Type);
+      Stabilize (Index);
+
+      if Get_Direction (Index_Range) = Dir_To then
+         --  Direction TO:  INDEX - LEFT.
+         if B /= 0 then
             Obound := Chap7.Translate_Static_Range_Left
               (Index_Range, Index_Base_Type);
-            Index := New_Dyadic_Op (ON_Sub_Ov, New_Lit (Obound), Index);
+            Off := New_Dyadic_Op (ON_Sub_Ov, M2E (Index), New_Lit (Obound));
+         else
+            Off := M2E (Index);
          end if;
+      else
+         --  Direction DOWNTO:  LEFT - INDEX.
+         Obound := Chap7.Translate_Static_Range_Left
+           (Index_Range, Index_Base_Type);
+         Off := New_Dyadic_Op (ON_Sub_Ov, New_Lit (Obound), M2E (Index));
+      end if;
 
-         --  Get the offset.
-         Index := New_Convert_Ov (Index, Ghdl_Index_Type);
+      --  Get the offset.
+      Off := New_Convert (Off, Ghdl_Index_Type);
 
-         --  Since the value is unsigned, both left and right bounds are
-         --  checked in the same time.
-         if Get_Type (Expr) /= Index_Type then
-            Res := Create_Temp_Init (Ghdl_Index_Type, Index);
+      --  Since the value is unsigned, both left and right bounds are
+      --  checked in the same time.
+      if Get_Type (Expr) /= Index_Type then
+         Res := Create_Temp_Init (Ghdl_Index_Type, Off);
 
-            Cond2 := New_Compare_Op
-              (ON_Ge, New_Obj_Value (Res),
-               New_Lit (Chap7.Translate_Static_Range_Length (Index_Range)),
-               Ghdl_Bool_Type);
-            Check_Bound_Error (Cond2, Expr, Dim);
-            Index := New_Obj_Value (Res);
+         Cond2 := New_Compare_Op
+           (ON_Ge, New_Obj_Value (Res),
+            New_Lit (Chap7.Translate_Static_Range_Length (Index_Range)),
+            Ghdl_Bool_Type);
+         if Index_Base_Type = Vhdl.Std_Package.Integer_Type_Definition then
+            Check_Integer_Bound_Error (Cond2, Index, Rng, Expr);
+         else
+            Check_Bound_Error (Cond2, Expr);
          end if;
-
-         return Index;
+         Off := New_Obj_Value (Res);
       end if;
+
+      return Off;
    end Translate_Thin_Index_Offset;
 
    function Stabilize_If_Unbounded (Val : Mnode) return Mnode is
@@ -410,14 +452,14 @@ package body Trans.Chap6 is
                   Chap7.Translate_Expression (Index, Ibasetype),
                   Null_Iir, Itype, Index);
             when Type_Mode_Bounded_Arrays =>
+               --  Manually extract range since there is no infos for
+               --   index subtype.
+               Range_Ptr := Chap3.Bounds_To_Range
+                 (Chap3.Get_Composite_Type_Bounds (Prefix_Type),
+                  Prefix_Type, Dim);
                if Prefix_Info.Type_Locally_Constrained then
-                  R := Translate_Thin_Index_Offset (Itype, Dim, Index);
+                  R := Translate_Thin_Index_Offset (Itype, Index, Range_Ptr);
                else
-                  --  Manually extract range since there is no infos for
-                  --   index subtype.
-                  Range_Ptr := Chap3.Bounds_To_Range
-                    (Chap3.Get_Composite_Type_Bounds (Prefix_Type),
-                     Prefix_Type, Dim);
                   Stabilize (Range_Ptr);
                   R := Translate_Index_To_Offset
                     (Range_Ptr,
@@ -729,7 +771,7 @@ package body Trans.Chap6 is
                            M2E (Chap3.Range_To_Length (Slice_Range))),
             M2E (Chap3.Range_To_Length (Prefix_Range)),
             Ghdl_Bool_Type);
-         Check_Bound_Error (New_Dyadic_Op (ON_Or, Err_1, Err_2), Expr, 1);
+         Check_Bound_Error (New_Dyadic_Op (ON_Or, Err_1, Err_2), Expr);
       end;
       Finish_If_Stmt (If_Blk);
 
diff --git a/src/vhdl/translate/trans-chap6.ads b/src/vhdl/translate/trans-chap6.ads
index 90ffa9390..db4909c26 100644
--- a/src/vhdl/translate/trans-chap6.ads
+++ b/src/vhdl/translate/trans-chap6.ads
@@ -70,7 +70,7 @@ package Trans.Chap6 is
    --  index violation for dimension DIM of an array.  LOC is usually
    --  the expression which has computed the index and is used only for
    --  its location.
-   procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir; Dim : Natural);
+   procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir);
 
    --  Get the deepest range_expression of ATYPE.
    --   This follows 'range and 'reverse_range.
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 91cf539f7..d2b97fe1e 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -425,7 +425,7 @@ package body Trans.Chap7 is
                New_Lit (New_Index_Lit (Unsigned_64 (Len))),
                Chap3.Get_Array_Type_Length (Lit_Type),
                Ghdl_Bool_Type),
-            Str, 1);
+            Str);
       else
          raise Internal_Error;
       end if;
@@ -3392,7 +3392,7 @@ package body Trans.Chap7 is
                             (Chap3.Bounds_To_Range
                                (Bounds, Target_Type, I + 1))),
                      Ghdl_Bool_Type),
-                  Aggr, I);
+                  Aggr);
             end;
             Close_Temp;
          elsif Get_Type_Staticness (Subaggr_Type) /= Locally
@@ -3465,7 +3465,7 @@ package body Trans.Chap7 is
                   end if;
                   New_Assign_Stmt (New_Obj (Var_Err), E);
                end if;
-               Chap6.Check_Bound_Error (New_Obj_Value (Var_Err), Aggr, I);
+               Chap6.Check_Bound_Error (New_Obj_Value (Var_Err), Aggr);
                Close_Temp;
             end if;
          end if;
@@ -5312,7 +5312,7 @@ package body Trans.Chap7 is
                  (Dp2M (F_Info.Operator_Right, Tinfo, Mode_Value),
                   Arr_Type, 1),
                Ghdl_Bool_Type),
-            Subprg, 0);
+            Subprg);
       end if;
 
       --  Create the result from LEFT bound.
@@ -5952,10 +5952,10 @@ package body Trans.Chap7 is
 
                Chap6.Check_Bound_Error
                  (New_Compare_Op (ON_Gt,
-                  New_Obj_Value (Var_Len),
-                  Chap3.Get_Array_Length (Var, Etype),
-                  Ghdl_Bool_Type),
-                  Subprg, 1);
+                                  New_Obj_Value (Var_Len),
+                                  Chap3.Get_Array_Length (Var, Etype),
+                                  Ghdl_Bool_Type),
+                  Subprg);
                Translate_Rw_Array (Chap3.Get_Composite_Base (Var), Etype,
                                    Var_Len, Ghdl_Read_Scalar);
                New_Return_Stmt (New_Convert_Ov (New_Obj_Value (Var_Len),
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index ecfd0d76b..ace7f61b6 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -1415,7 +1415,7 @@ package body Trans.Chap8 is
                Expr_Type),
             New_Lit (New_Index_Lit (Unsigned_64 (Sel_Length))),
             Ghdl_Bool_Type);
-         Chap6.Check_Bound_Error (Cond, Expr, 0);
+         Chap6.Check_Bound_Error (Cond, Expr);
       end if;
    end Translate_String_Case_Statement_Common;
 
diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads
index d76b1b896..2f52b6035 100644
--- a/src/vhdl/translate/trans_decls.ads
+++ b/src/vhdl/translate/trans_decls.ads
@@ -173,6 +173,7 @@ package Trans_Decls is
    --  Procedure called in case of check failed.
    Ghdl_Program_Error : O_Dnode;
    Ghdl_Bound_Check_Failed : O_Dnode;
+   Ghdl_Integer_Index_Check_Failed : O_Dnode;
    Ghdl_Direction_Check_Failed : O_Dnode;
 
    --  Stack 2.
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 693212776..519671970 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -1107,6 +1107,21 @@ package body Translation is
          Check_Stack_Allocation_Threshold := O_Cnode_Null;
       end if;
 
+      --  procedure __ghdl_integer_indexed_check_failed
+      --   (filename : char_ptr_type;
+      --    line : ghdl_i32;
+      --    val : standard_integer;
+      --    rng : integer_range_ptr);
+      Start_Procedure_Decl
+        (Interfaces, Get_Identifier ("__ghdl_integer_index_check_failed"),
+         O_Storage_External);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Val, Std_Integer_Otype);
+      New_Interface_Decl (Interfaces, Param, Get_Identifier ("rng"),
+                          Get_Info (Integer_Type_Definition).B.Range_Ptr_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Integer_Index_Check_Failed);
+
       --  procedure __ghdl_text_write (file : __ghdl_file_index;
       --                               str  : std_string_ptr);
       Start_Procedure_Decl