Improved error reporting, Issue #26

6 files changed, 39 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.
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 2d74663e5..0d10a3d80 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -3309,6 +3309,7 @@ package body Trans.Chap8 is
             Start_Association (Constr, Ghdl_Process_Wait_Timeout);
             New_Association (Constr, Chap7.Translate_Expression
                              (Timeout, Time_Type_Definition));
+            Assoc_Filename_Line (Constr, Get_Line_Number (Stmt));
             New_Procedure_Call (Constr);
             Close_Temp;
          end if;
@@ -3333,6 +3334,7 @@ package body Trans.Chap8 is
          Start_Association (Constr, Ghdl_Process_Wait_Set_Timeout);
          New_Association (Constr, Chap7.Translate_Expression
                           (Timeout, Time_Type_Definition));
+         Assoc_Filename_Line (Constr, Get_Line_Number (Stmt));
          New_Procedure_Call (Constr);
       end if;
 
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index ecf5c778a..42620ba91 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -1712,6 +1712,8 @@ package body Translation is
          O_Storage_External);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"),
                           Std_Time_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Timeout);
 
       --  void __ghdl_process_wait_set_timeout (time : std_time);
@@ -1720,6 +1722,8 @@ package body Translation is
          O_Storage_External);
       New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"),
                           Std_Time_Otype);
+      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
+      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Set_Timeout);
 
       --  void __ghdl_process_wait_add_sensitivity (sig : __ghdl_signal_ptr);