aboutsummaryrefslogtreecommitdiffstats
path: root/src/grt
diff options
context:
space:
mode:
authorBrian Drummond <brian@shapes.demon.co.uk>2017-10-05 19:19:01 +0100
committerTristan Gingold <tgingold@free.fr>2017-10-06 20:40:30 +0200
commit3ed10bea5275a9a0f8d6cc6c13b90bc02cb42d75 (patch)
treec419fba15feb91741e0a24fac82805a0176a566c /src/grt
parentda6dd57e9e5ee865cbd0cc9246eebcad957adae6 (diff)
downloadghdl-3ed10bea5275a9a0f8d6cc6c13b90bc02cb42d75.tar.gz
ghdl-3ed10bea5275a9a0f8d6cc6c13b90bc02cb42d75.tar.bz2
ghdl-3ed10bea5275a9a0f8d6cc6c13b90bc02cb42d75.zip
Improved error reporting, Issue #26
Diffstat (limited to 'src/grt')
-rw-r--r--src/grt/grt-errors.adb14
-rw-r--r--src/grt/grt-errors.ads5
-rw-r--r--src/grt/grt-processes.adb14
-rw-r--r--src/grt/grt-processes.ads8
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.