From fe3810861d6359f4a7c27b295b03f46e3941199a Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 11 Jan 2023 19:21:43 +0100
Subject: synth: report values in bound errors

---
 src/errorout.adb              | 18 +++++++++++++++++-
 src/synth/synth-vhdl_expr.adb | 31 +++++++++++++++++++++++--------
 2 files changed, 40 insertions(+), 9 deletions(-)

diff --git a/src/errorout.adb b/src/errorout.adb
index 4f0746fcb..39d4af782 100644
--- a/src/errorout.adb
+++ b/src/errorout.adb
@@ -214,6 +214,18 @@ package body Errorout is
       Report_Handler.Message (S (2 .. S'Last));
    end Output_Uns32;
 
+   procedure Output_Int32 (V : Int32)
+   is
+      S : constant String := Int32'Image (V);
+      F : Positive;
+   begin
+      F := 1;
+      if S (F) = ' ' then
+         F := 2;
+      end if;
+      Report_Handler.Message (S (F .. S'Last));
+   end Output_Int32;
+
    procedure Output_String8 (Str : String8_Len_Type) is
    begin
       Report_Handler.Message ("""");
@@ -348,7 +360,11 @@ package body Errorout is
                               raise Internal_Error;
                            end if;
                         when Earg_Int32 =>
-                           raise Internal_Error;
+                           if Format = 'v' then
+                              Output_Int32 (Arg.Val_Int32);
+                           else
+                              raise Internal_Error;
+                           end if;
                         when Earg_Lang_Kind =>
                            if Lang_Handlers (Arg.Kind) = null then
                               raise Internal_Error;
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index 56ecbb310..c330065a2 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -817,9 +817,21 @@ package body Synth.Vhdl_Expr is
       end case;
    end Synth_Name;
 
-   procedure Bound_Error (Syn_Inst : Synth_Instance_Acc; Loc : Node) is
+   procedure Bound_Error (Syn_Inst : Synth_Instance_Acc;
+                          Loc : Node;
+                          Bnd : Bound_Type;
+                          Val : Int32) is
    begin
-      Error_Msg_Synth (Syn_Inst, Loc, "index not within bounds");
+      case Bnd.Dir is
+         when Dir_To =>
+            Error_Msg_Synth (Syn_Inst, Loc,
+                             "index (%v) out of bounds (%v to %v)",
+                             (+Val, +Bnd.Left, +Bnd.Right));
+         when Dir_Downto =>
+            Error_Msg_Synth (Syn_Inst, Loc,
+                             "index (%v) out of bounds (%v downto %v)",
+                             (+Val, +Bnd.Left, +Bnd.Right));
+      end case;
    end Bound_Error;
 
    --  Convert index IDX in PFX to an offset.
@@ -831,7 +843,7 @@ package body Synth.Vhdl_Expr is
       Res : Value_Offsets;
    begin
       if not In_Bounds (Bnd, Int32 (Idx)) then
-         Bound_Error (Syn_Inst, Loc);
+         Bound_Error (Syn_Inst, Loc, Bnd, Int32 (Idx));
          return (0, 0);
       end if;
 
@@ -928,7 +940,7 @@ package body Synth.Vhdl_Expr is
       if Is_Static_Val (Idx_Val.Val) then
          Idx := Get_Static_Discrete (Idx_Val);
          if not In_Bounds (Bnd, Int32 (Idx)) then
-            Bound_Error (Syn_Inst, Idx_Expr);
+            Bound_Error (Syn_Inst, Idx_Expr, Bnd, Int32 (Idx));
             Error := True;
          else
             Idx_Off := Index_To_Offset (Syn_Inst, Bnd, Idx, Idx_Expr);
@@ -1245,10 +1257,13 @@ package body Synth.Vhdl_Expr is
          Len := 0;
          Off := (0, 0);
       else
-         if not In_Bounds (Pfx_Bnd, Int32 (L))
-           or else not In_Bounds (Pfx_Bnd, Int32 (R))
-         then
-            Error_Msg_Synth (Syn_Inst, Expr, "index not within bounds");
+         if not In_Bounds (Pfx_Bnd, Int32 (L)) then
+            Bound_Error (Syn_Inst, Expr, Pfx_Bnd, Int32 (L));
+            Off := (0, 0);
+            return;
+         end if;
+         if not In_Bounds (Pfx_Bnd, Int32 (R)) then
+            Bound_Error (Syn_Inst, Expr, Pfx_Bnd, Int32 (R));
             Off := (0, 0);
             return;
          end if;
-- 
cgit v1.2.3