From ab1a4bd15ed0d9e8c8ecbffd62e11e2c78ff1f28 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Mon, 25 May 2020 19:48:09 +0200
Subject: grt: implement --backtrace-severity. For #1338
---
src/grt/grt-lib.adb | 4 ++++
src/grt/grt-options.adb | 52 ++++++++++++++++++++++++++++++++++++------------
src/grt/grt-options.ads | 4 ++++
src/grt/grt-severity.ads | 3 +++
4 files changed, 50 insertions(+), 13 deletions(-)
(limited to 'src')
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb
index 66d1ccccf..3bd3440ec 100644
--- a/src/grt/grt-lib.adb
+++ b/src/grt/grt-lib.adb
@@ -29,6 +29,7 @@ with Grt.Errors_Exec; use Grt.Errors_Exec;
with Grt.Severity;
with Grt.Options;
with Grt.Fcvt;
+with Grt.Backtraces;
package body Grt.Lib is
--procedure Memcpy (Dst : Address; Src : Address; Size : Size_T);
@@ -89,6 +90,9 @@ package body Grt.Lib is
Error_S (Msg);
Diag_C (" failed");
Error_E_Call_Stack (Bt);
+ elsif Level >= Grt.Options.Backtrace_Severity then
+ Save_Backtrace (Bt, 2);
+ Grt.Backtraces.Put_Err_Backtrace (Bt);
end if;
end Do_Report;
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
index 379d1978e..097a9d6da 100644
--- a/src/grt/grt-options.adb
+++ b/src/grt/grt-options.adb
@@ -71,6 +71,7 @@ package body Grt.Options is
P (" --help, -h disp this help");
P (" --assert-level=LEVEL stop simulation if assert at LEVEL");
P (" LEVEL is note,warning,error,failure,none");
+ P (" --backtrace-severity=LEVEL display a backtrace for assertions");
P (" --ieee-asserts=POLICY enable or disable asserts from IEEE");
P (" POLICY is enable,disable,disable-at-0");
P (" --stop-time=X stop the simulation at time X");
@@ -191,6 +192,26 @@ package body Grt.Options is
return Std_Time (Time);
end Parse_Time;
+ function Parse_Severity (Opt_Name : String; Arg : String) return Integer is
+ begin
+ if Arg = "note" then
+ return Note_Severity;
+ elsif Arg = "warning" then
+ return Warning_Severity;
+ elsif Arg = "error" then
+ return Error_Severity;
+ elsif Arg = "failure" then
+ return Failure_Severity;
+ elsif Arg = "none" then
+ return 4;
+ else
+ Error_S ("bad argument for ");
+ Diag_C (Opt_Name);
+ Error_E (" option, try --help");
+ return -1;
+ end if;
+ end Parse_Severity;
+
procedure Decode_Option
(Option : String; Status : out Decode_Option_Status)
is
@@ -265,19 +286,24 @@ package body Grt.Options is
end if;
end;
elsif Len > 15 and then Option (1 .. 15) = "--assert-level=" then
- if Option (16 .. Len) = "note" then
- Severity_Level := Note_Severity;
- elsif Option (16 .. Len) = "warning" then
- Severity_Level := Warning_Severity;
- elsif Option (16 .. Len) = "error" then
- Severity_Level := Error_Severity;
- elsif Option (16 .. Len) = "failure" then
- Severity_Level := Failure_Severity;
- elsif Option (16 .. Len) = "none" then
- Severity_Level := 4;
- else
- Error ("bad argument for --assert-level option, try --help");
- end if;
+ declare
+ Level : Integer;
+ begin
+ Level := Parse_Severity ("--assert-level", Option (16 .. Len));
+ if Level >= 0 then
+ Severity_Level := Level;
+ end if;
+ end;
+ elsif Len > 21 and then Option (1 .. 21) = "--backtrace-severity=" then
+ declare
+ Level : Integer;
+ begin
+ Level := Parse_Severity
+ ("--backtrace-severity", Option (22 .. Len));
+ if Level >= 0 then
+ Backtrace_Severity := Level;
+ end if;
+ end;
elsif Len > 15 and then Option (1 .. 15) = "--ieee-asserts=" then
if Option (16 .. Len) = "disable" then
Ieee_Asserts := Disable_Asserts;
diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads
index 3d5a8bf15..495391e43 100644
--- a/src/grt/grt-options.ads
+++ b/src/grt/grt-options.ads
@@ -119,9 +119,13 @@ package Grt.Options is
-- Set by --checks to do internal checks.
Checks : Boolean := False;
+ -- For --assert-level
-- Level at which an assert stop the simulation.
Severity_Level : Integer := Grt.Severity.Failure_Severity;
+ -- Level at which an assert displays a backtrace.
+ Backtrace_Severity : Integer := Grt.Severity.None_Severity;
+
-- How assertions are handled.
type Assert_Handling is
(Enable_Asserts,
diff --git a/src/grt/grt-severity.ads b/src/grt/grt-severity.ads
index 75d8d90d9..681f3c30c 100644
--- a/src/grt/grt-severity.ads
+++ b/src/grt/grt-severity.ads
@@ -30,4 +30,7 @@ package Grt.Severity is
Warning_Severity : constant Integer := 1;
Error_Severity : constant Integer := 2;
Failure_Severity : constant Integer := 3;
+
+ -- Value returned by Parse_Severity for 'none'.
+ None_Severity : constant Integer := 4;
end Grt.Severity;
--
cgit v1.2.3