vhdl: add ghdl_integer_index_check_failed. For #1257

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

3 files changed, 44 insertions, 0 deletions

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);