Improved error reporting, Issue #26

4 files changed, 33 insertions, 8 deletions

diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index e9e2f54ad..51a50418c 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -254,6 +254,20 @@ package body Grt.Errors is
       Fatal_Error;
    end Error;
 
+   procedure Error (Str : String;
+                    Filename : Ghdl_C_String;
+                    Line : Ghdl_I32) is
+   begin
+      Error_H;
+      Put_Err (Str);
+      Put_Err (" at ");
+      Put_Err (Filename);
+      Put_Err (" line ");
+      Put_I32 (Error_Stream, Line);
+      Newline_Err;
+      Fatal_Error;
+   end Error;
+
    procedure Info (Str : String) is
    begin
       Put_Err (Progname);
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index 5d316aaea..ceaef6a8e 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -58,6 +58,11 @@ package Grt.Errors is
    procedure Error (Str : String);
    pragma No_Return (Error);
 
+   procedure Error (Str : String;
+                    Filename : Ghdl_C_String;
+                    Line : Ghdl_I32);
+   pragma No_Return (Error);
+
    --  Warning message.
    procedure Warning (Str : String);
 
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index de39cde53..a1137210d 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -388,14 +388,15 @@ package body Grt.Processes is
       Proc.Timeout_Chain_Prev := null;
    end Remove_Process_From_Timeout_Chain;
 
-   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time;
+                                            Filename : Ghdl_C_String;
+                                            Line : Ghdl_I32)
    is
       Proc : constant Process_Acc := Get_Current_Process;
    begin
       if Time < 0 then
          --  LRM93 8.1
-         Disp_Process_Name (Get_Error_Stream, Proc);
-         Error ("negative timeout clause");
+         Error ("negative timeout clause", Filename, Line);
       end if;
       Proc.Timeout := Current_Time + Time;
       Update_Process_First_Timeout (Proc);
@@ -514,7 +515,9 @@ package body Grt.Processes is
       Proc.State := State_Dead;
    end Ghdl_Process_Wait_Exit;
 
-   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time;
+                                        Filename : Ghdl_C_String;
+                                        Line : Ghdl_I32)
    is
       Proc : constant Process_Acc := Get_Current_Process;
    begin
@@ -523,8 +526,7 @@ package body Grt.Processes is
       end if;
       if Time < 0 then
          --  LRM93 8.1
-         Disp_Process_Name (Get_Error_Stream, Proc);
-         Error ("negative timeout clause");
+         Error ("negative timeout clause", Filename, Line);
       end if;
       Proc.State := State_Delayed;
       if Time <= Std_Time'Last - Current_Time then
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index e09f553e5..818b81f7d 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -124,7 +124,9 @@ package Grt.Processes is
    procedure Ghdl_Process_Wait_Exit;
 
    --  Wait for a timeout (without sensitivity): wait for X;
-   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time);
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time;
+                                        Filename : Ghdl_C_String;
+                                        Line : Ghdl_I32);
 
    --  Full wait statement:
    --  1. Call Ghdl_Process_Wait_Set_Timeout (if there is a timeout)
@@ -135,7 +137,9 @@ package Grt.Processes is
    --  4. Call Ghdl_Process_Wait_Close
 
    --  Add a timeout for a wait.
-   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time);
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time;
+                                            Filename : Ghdl_C_String;
+                                            Line : Ghdl_I32);
    --  Add a sensitivity for a wait.
    procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
    --  Wait until timeout or sensitivity.