diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-09-06 02:43:27 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-09-06 02:43:27 +0200 |
commit | 0061426b03bd806424e813fc7065478a8791d1e7 (patch) | |
tree | f2dc5c99d97b3f145618b2591bf5143636d38de2 | |
parent | e951db00727e858fc11a78af7e33de12567575df (diff) | |
download | ghdl-0061426b03bd806424e813fc7065478a8791d1e7.tar.gz ghdl-0061426b03bd806424e813fc7065478a8791d1e7.tar.bz2 ghdl-0061426b03bd806424e813fc7065478a8791d1e7.zip |
simul: add an hook to display report/assert message
-rw-r--r-- | src/simul/simul-vhdl_simul.adb | 64 | ||||
-rw-r--r-- | src/synth/synth-vhdl_stmts.adb | 100 | ||||
-rw-r--r-- | src/synth/synth-vhdl_stmts.ads | 14 |
3 files changed, 128 insertions, 50 deletions
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb index 0e19a3159..a3638f21e 100644 --- a/src/simul/simul-vhdl_simul.adb +++ b/src/simul/simul-vhdl_simul.adb @@ -60,6 +60,7 @@ with Grt.Stdio; with Grt.Processes; with Grt.Main; with Grt.Errors; +with Grt.Severity; with Grt.Lib; with Grt.Analog_Solver; @@ -940,6 +941,47 @@ package body Simul.Vhdl_Simul is Release_Expr_Pool (Marker); end Execute_Selected_Signal_Assignment; + procedure Assertion_Report_Msg (Inst : Synth_Instance_Acc; + Stmt : Node; + Severity : Natural; + Msg : Valtyp) + is + pragma Unreferenced (Inst); + use Grt.Severity; + use Grt.Errors; + begin + Report_S (Vhdl.Errors.Disp_Location (Stmt)); + Diag_C (":@"); + Diag_C_Now; + Diag_C (":("); + if Get_Kind (Stmt) = Iir_Kind_Report_Statement then + Diag_C ("report"); + else + Diag_C ("assert"); + end if; + Diag_C (' '); + case Severity is + when Note_Severity => + Diag_C ("note"); + when Warning_Severity => + Diag_C ("warning"); + when Error_Severity => + Diag_C ("error"); + when Failure_Severity => + Diag_C ("failure"); + when others => + Diag_C ("??"); + end case; + Diag_C ("): "); + + if Msg = No_Valtyp then + Diag_C ("Assertion violation."); + else + Diag_C (Value_To_String (Msg)); + end if; + Report_E; + end Assertion_Report_Msg; + procedure Execute_Assertion_Statement (Inst : Synth_Instance_Acc; Stmt : Node) is @@ -961,8 +1003,7 @@ package body Simul.Vhdl_Simul is end if; end case; - Exec_Failed_Assertion - (Inst, Stmt, "assertion", "Assertion violation.", 2); + Exec_Failed_Assertion (Inst, Stmt); end Execute_Assertion_Statement; procedure Execute_Sequential_Statements_Inner (Process : Process_State_Acc; @@ -1564,22 +1605,16 @@ package body Simul.Vhdl_Simul is case Get_Kind (E.Proc) is when Iir_Kind_Psl_Assert_Directive => if Nvec (S_Num) then - Exec_Failed_Assertion - (E.Instance, E.Proc, - "psl assertion", "assertion violation", 2); + Exec_Failed_Assertion (E.Instance, E.Proc); end if; when Iir_Kind_Psl_Assume_Directive => if Nvec (S_Num) then - Exec_Failed_Assertion - (E.Instance, E.Proc, - "psl assumption", "assumption violation", 2); + Exec_Failed_Assertion (E.Instance, E.Proc); end if; when Iir_Kind_Psl_Cover_Directive => if Nvec (S_Num) then if Get_Report_Expression (E.Proc) /= Null_Iir then - Exec_Failed_Assertion - (E.Instance, E.Proc, - "psl cover", "sequence covered", 0); + Exec_Failed_Assertion (E.Instance, E.Proc); end if; E.Done := True; end if; @@ -1624,9 +1659,7 @@ package body Simul.Vhdl_Simul is and then Execute_Psl_Expr (Ent.Instance, Get_Edge_Expr (E), True) then - Exec_Failed_Assertion - (Ent.Instance, Ent.Proc, - "psl assertion", "assertion violation", 2); + Exec_Failed_Assertion (Ent.Instance, Ent.Proc); exit; end if; end if; @@ -2996,6 +3029,9 @@ package body Simul.Vhdl_Simul is Grt.Analog_Solver.Start; end if; + Grt.Errors.Set_Error_Stream (Grt.Stdio.stdout); + Assertion_Report_Handler := Assertion_Report_Msg'Access; + loop if Break_Time < Grt.Processes.Next_Time then Grt.Processes.Next_Time := Break_Time; diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index dcd7cd06d..23da44f73 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -3058,10 +3058,7 @@ package body Synth.Vhdl_Stmts is end Synth_Return_Statement; procedure Exec_Failed_Assertion (Syn_Inst : Synth_Instance_Acc; - Stmt : Node; - Stmt_Msg : String; - Default_Rep : String; - Default_Severity : Natural) + Stmt : Node) is use Simple_IO; Rep_Expr : constant Node := Get_Report_Expression (Stmt); @@ -3090,33 +3087,75 @@ package body Synth.Vhdl_Stmts is Strip_Const (Sev); end if; - Put_Err (Disp_Location (Stmt)); - Put_Err (":("); - Put_Err (Stmt_Msg); - Put_Err (' '); if Sev = No_Valtyp then - Sev_V := Default_Severity; + case Get_Kind (Stmt) is + when Iir_Kind_Report_Statement + | Iir_Kind_Psl_Cover_Directive => + Sev_V := Note_Severity; + when Iir_Kind_Assertion_Statement + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Assert_Directive + | Iir_Kind_Psl_Assume_Directive => + Sev_V := Error_Severity; + when others => + raise Internal_Error; + end case; else Sev_V := Natural (Read_Discrete (Sev)); end if; - case Sev_V is - when Note_Severity => - Put_Err ("note"); - when Warning_Severity => - Put_Err ("warning"); - when Error_Severity => - Put_Err ("error"); - when Failure_Severity => - Put_Err ("failure"); - when others => - Put_Err ("??"); - end case; - Put_Err ("): "); - if Rep = No_Valtyp then - Put_Line_Err (Default_Rep); + if Assertion_Report_Handler /= null then + Assertion_Report_Handler (Syn_Inst, Stmt, Sev_V, Rep); else - Put_Line_Err (Value_To_String (Rep)); + Put_Err (Disp_Location (Stmt)); + Put_Err (":("); + case Get_Kind (Stmt) is + when Iir_Kind_Report_Statement => + Put_Err ("report"); + when Iir_Kind_Assertion_Statement + | Iir_Kind_Concurrent_Assertion_Statement => + Put_Err ("assert"); + when Iir_Kind_Psl_Assert_Directive => + Put_Err ("psl assertion"); + when Iir_Kind_Psl_Assume_Directive => + Put_Err ("psl assumption"); + when Iir_Kind_Psl_Cover_Directive => + Put_Err ("psl cover"); + when others => + raise Internal_Error; + end case; + Put_Err (' '); + case Sev_V is + when Note_Severity => + Put_Err ("note"); + when Warning_Severity => + Put_Err ("warning"); + when Error_Severity => + Put_Err ("error"); + when Failure_Severity => + Put_Err ("failure"); + when others => + Put_Err ("??"); + end case; + Put_Err ("): "); + + if Rep = No_Valtyp then + case Get_Kind (Stmt) is + when Iir_Kind_Report_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Assert_Directive => + Put_Err ("Assertion violation."); + when Iir_Kind_Psl_Assume_Directive => + Put_Err ("Assumption violation."); + when Iir_Kind_Psl_Cover_Directive => + Put_Err ("sequence coveredr"); + when others => + raise Internal_Error; + end case; + else + Put_Line_Err (Value_To_String (Rep)); + end if; end if; Release_Expr_Pool (Marker); @@ -3130,7 +3169,7 @@ package body Synth.Vhdl_Stmts is procedure Execute_Report_Statement (Inst : Synth_Instance_Acc; Stmt : Node) is begin - Exec_Failed_Assertion (Inst, Stmt, "report", "Assertion violation.", 0); + Exec_Failed_Assertion (Inst, Stmt); end Execute_Report_Statement; -- Return True if EXPR can be evaluated with static values. @@ -3171,8 +3210,7 @@ package body Synth.Vhdl_Stmts is and then (Sev_Expr = Null_Node or else Is_Static_Expr (Inst, Sev_Expr)) then - Exec_Failed_Assertion - (Inst, Stmt, "report", "Assertion violation.", 0); + Exec_Failed_Assertion (Inst, Stmt); end if; end Synth_Dynamic_Report_Statement; @@ -3191,8 +3229,7 @@ package body Synth.Vhdl_Stmts is if Read_Discrete (Cond) = 1 then return; end if; - Exec_Failed_Assertion - (Inst, Stmt, "assertion", "Assertion violation.", 2); + Exec_Failed_Assertion (Inst, Stmt); end Execute_Assertion_Statement; procedure Synth_Dynamic_Assertion_Statement (C : Seq_Context; Stmt : Node) @@ -3474,8 +3511,7 @@ package body Synth.Vhdl_Stmts is end if; if Is_Static (Val.Val) then if Read_Discrete (Val) /= 1 then - Exec_Failed_Assertion - (Syn_Inst, Stmt, "assertion", "Assertion violation.", 2); + Exec_Failed_Assertion (Syn_Inst, Stmt); end if; return; end if; diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads index db78c44d7..99aa5ff97 100644 --- a/src/synth/synth-vhdl_stmts.ads +++ b/src/synth/synth-vhdl_stmts.ads @@ -28,6 +28,15 @@ with Netlists; use Netlists; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; package Synth.Vhdl_Stmts is + type Assertion_Report_Handler_Acc is access procedure + (Inst : Synth_Instance_Acc; + Stmt : Node; + Severity : Natural; + Msg : Valtyp); + + -- Procedure to call for report/assertion message. + Assertion_Report_Handler : Assertion_Report_Handler_Acc; + -- Create a new Synth_Instance for calling subprogram IMP/BOD. function Synth_Subprogram_Call_Instance (Inst : Synth_Instance_Acc; Imp : Node; @@ -104,10 +113,7 @@ package Synth.Vhdl_Stmts is procedure Execute_Report_Statement (Inst : Synth_Instance_Acc; Stmt : Node); procedure Exec_Failed_Assertion (Syn_Inst : Synth_Instance_Acc; - Stmt : Node; - Stmt_Msg : String; - Default_Rep : String; - Default_Severity : Natural); + Stmt : Node); procedure Init_For_Loop_Statement (Inst : Synth_Instance_Acc; Stmt : Node; |