diff options
Diffstat (limited to 'src/grt')
| -rw-r--r-- | src/grt/grt-errors.adb | 83 | ||||
| -rw-r--r-- | src/grt/grt-errors.ads | 21 | ||||
| -rw-r--r-- | src/grt/grt-lib.adb | 57 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt-design.adb | 12 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt-file.adb | 27 | ||||
| -rw-r--r-- | src/grt/grt-wave_opt.adb | 19 |
6 files changed, 95 insertions, 124 deletions
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb index 325059469..5070031e5 100644 --- a/src/grt/grt-errors.adb +++ b/src/grt/grt-errors.adb @@ -112,11 +112,25 @@ package body Grt.Errors is Put (Error_Stream, Str_Subtype (Str)); end Diag_C_Std; + procedure Diag_C (Str : Std_String_Ptr) + is + subtype Ada_Str is String (1 .. Natural (Str.Bounds.Dim_1.Length)); + begin + if Ada_Str'Length > 0 then + Diag_C (Ada_Str (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1))); + end if; + end Diag_C; + procedure Diag_C (C : Character) is begin Put (Error_Stream, C); end Diag_C; + procedure Diag_C_Now is + begin + Put_Time (Error_Stream, Grt.Types.Current_Time); + end Diag_C_Now; + procedure Newline_Err is begin New_Line (Error_Stream); @@ -136,52 +150,26 @@ package body Grt.Errors is -- end if; -- end Put_Err; - procedure Report_H (Str : String := "") is - begin - Put_Err (Str); - end Report_H; - - procedure Report_C (Str : String) is - begin - Put_Err (Str); - end Report_C; - - procedure Report_C (Str : Ghdl_C_String) - is - Len : constant Natural := strlen (Str); - begin - Put_Err (Str (1 .. Len)); - end Report_C; - - procedure Report_C (N : Integer) - renames Put_Err; - - procedure Report_Now_C is + procedure Report_S (Str : String := "") is begin - Put_Time (Error_Stream, Grt.Types.Current_Time); - end Report_Now_C; + Diag_C (Str); + end Report_S; - procedure Report_E (Str : String) is + procedure Report_E is begin - Put_Err (Str); Newline_Err; end Report_E; - procedure Report_E (N : Integer) is + procedure Warning_S (Str : String := "") is begin - Put_Err (N); - Newline_Err; - end Report_E; + Diag_C ("warning: "); + Diag_C (Str); + end Warning_S; - procedure Report_E (Str : Std_String_Ptr) - is - subtype Ada_Str is String (1 .. Natural (Str.Bounds.Dim_1.Length)); + procedure Warning_E is begin - if Ada_Str'Length > 0 then - Put_Err (Ada_Str (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1))); - end if; Newline_Err; - end Report_E; + end Warning_E; procedure Error_S (Str : String := "") is begin @@ -191,29 +179,6 @@ package body Grt.Errors is Diag_C (Str); end Error_S; --- procedure Error_C (Inst : Ghdl_Instance_Name_Acc) --- is --- begin --- if not Cont then --- Error_H; --- Cont := True; --- end if; --- if Inst.Parent /= null then --- Error_C (Inst.Parent); --- Put_Err ("."); --- end if; --- case Inst.Kind is --- when Ghdl_Name_Architecture => --- Put_Err ("("); --- Put_Err (Inst.Name.all); --- Put_Err (")"); --- when others => --- if Inst.Name /= null then --- Put_Err (Inst.Name.all); --- end if; --- end case; --- end Error_C; - procedure Error_E (Str : String := "") is begin Diag_C (Str); diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads index 976f2291c..a0ba1a03e 100644 --- a/src/grt/grt-errors.ads +++ b/src/grt/grt-errors.ads @@ -56,23 +56,22 @@ package Grt.Errors is procedure Diag_C (N : Integer); procedure Diag_C (N : Ghdl_I32); procedure Diag_C (Str : Ghdl_C_String); + procedure Diag_C (Str : Std_String_Ptr); procedure Diag_C_Std (Str : Std_String_Uncons); + procedure Diag_C_Now; - -- Multi-call error procedure. - -- Start and continue with Error_C, finish by an Error_E. + -- Multi-call error diagnostic. procedure Error_S (Str : String := ""); procedure Error_E (Str : String := ""); pragma No_Return (Error_E); - -- Multi-call report procedure. Do not exit at end. - procedure Report_H (Str : String := ""); - procedure Report_C (Str : Ghdl_C_String); - procedure Report_C (Str : String); - procedure Report_C (N : Integer); - procedure Report_Now_C; - procedure Report_E (Str : String); - procedure Report_E (Str : Std_String_Ptr); - procedure Report_E (N : Integer); + -- Multi-call report diagnostic. Do not exit at end. + procedure Report_S (Str : String := ""); + procedure Report_E; + + -- Multi-call warning diagnostic. Do not exit at end. + procedure Warning_S (Str : String := ""); + procedure Warning_E; -- Complete error message. procedure Error (Str : String); diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb index 01c958c42..2442998fe 100644 --- a/src/grt/grt-lib.adb +++ b/src/grt/grt-lib.adb @@ -51,35 +51,36 @@ package body Grt.Lib is Level : constant Integer := Severity mod 256; Bt : Backtrace_Addrs; begin - Report_H; - Report_C (Loc.Filename); - Report_C (":"); - Report_C (Loc.Line); - Report_C (":"); - Report_C (Loc.Col); - Report_C (":@"); - Report_Now_C; - Report_C (":("); - Report_C (Msg); - Report_C (" "); + Report_S; + Diag_C (Loc.Filename); + Diag_C (':'); + Diag_C (Loc.Line); + Diag_C (':'); + Diag_C (Loc.Col); + Diag_C (":@"); + Diag_C_Now; + Diag_C (":("); + Diag_C (Msg); + Diag_C (" "); case Level is when Note_Severity => - Report_C ("note"); + Diag_C ("note"); when Warning_Severity => - Report_C ("warning"); + Diag_C ("warning"); when Error_Severity => - Report_C ("error"); + Diag_C ("error"); when Failure_Severity => - Report_C ("failure"); + Diag_C ("failure"); when others => - Report_C ("???"); + Diag_C ("???"); end case; - Report_C ("): "); + Diag_C ("): "); if Str /= null then - Report_E (Str); + Diag_C (Str); else - Report_E (Default_Str); + Diag_C (Default_Str); end if; + Report_E; if Level >= Grt.Options.Severity_Level then Save_Backtrace (Bt, 2); Error_S (Msg); @@ -320,21 +321,21 @@ package body Grt.Lib is procedure Ghdl_Control_Simulation (Stop : Ghdl_B1; Has_Status : Ghdl_B1; Status : Std_Integer) is begin - Report_H; + Report_S; -- Report_C (Grt.Options.Progname); - Report_C ("simulation "); + Diag_C ("simulation "); if Stop then - Report_C ("stopped"); + Diag_C ("stopped"); else - Report_C ("finished"); + Diag_C ("finished"); end if; - Report_C (" @"); - Report_Now_C; + Diag_C (" @"); + Diag_C_Now; if Has_Status then - Report_C (" with status "); - Report_C (Integer (Status)); + Diag_C (" with status "); + Diag_C (Integer (Status)); end if; - Report_E (""); + Report_E; if Has_Status then Exit_Status := Integer (Status); end if; diff --git a/src/grt/grt-wave_opt-design.adb b/src/grt/grt-wave_opt-design.adb index 989969ecd..8ef0a73cd 100644 --- a/src/grt/grt-wave_opt-design.adb +++ b/src/grt/grt-wave_opt-design.adb @@ -207,13 +207,15 @@ package body Grt.Wave_Opt.Design is while Cursor /= null loop if Cursor.Kind = Not_Found then Print_Context (Cursor, Warning); - Report_C (Cursor.Expr.all); - Report_C (" : first element of the path not found in design."); - Report_E (" More references may follow"); + Diag_C (Cursor.Expr.all); + Diag_C (" : first element of the path not found in design."); + Diag_C (" More references may follow"); + Warning_E; elsif Cursor.Next_Child = null and then Cursor.Kind = Pkg_Entity then Print_Context (Cursor, Warning); - Report_C (Cursor.Expr.all); - Report_E (" is not a signal"); + Diag_C (Cursor.Expr.all); + Diag_C (" is not a signal"); + Warning_E; else Check_Sub_Tree_If_All_Found (Cursor.Next_Child); end if; diff --git a/src/grt/grt-wave_opt-file.adb b/src/grt/grt-wave_opt-file.adb index 109dd98c7..32f70593a 100644 --- a/src/grt/grt-wave_opt-file.adb +++ b/src/grt/grt-wave_opt-file.adb @@ -125,15 +125,16 @@ package body Grt.Wave_Opt.File is end loop; if Version.Major = -1 then - Report_C ("warning: version wasn't set at the beginning of the" & + Warning_S ("version wasn't set at the beginning of the" & " file; currently supported version is "); Print_Version (Current_Version); - Report_E (""); + Warning_E; end if; if Tree_Is_Empty then - Report_E ("No signal path was found in the wave option file," & - " then every signals will be displayed."); + Warning_S ("No signal path was found in the wave option file," & + " then every signals will be displayed."); + Warning_E; end if; fclose (Stream); @@ -211,9 +212,9 @@ package body Grt.Wave_Opt.File is procedure Print_Version (Version : Version_Type) is begin - Report_C (Version.Major); - Report_C ("."); - Report_C (Version.Minor); + Diag_C (Version.Major); + Diag_C ('.'); + Diag_C (Version.Minor); end Print_Version; procedure Initialize_Tree is @@ -305,9 +306,10 @@ package body Grt.Wave_Opt.File is -- Then /top/a will supercede /top/a/b. if not Tree_Updated and Tree_Cursor.Next_Child /= null then Print_Context (Lineno, Line'First, Warning); - Report_C ("supercedes line "); - Report_C (Tree_Cursor.Lineno); - Report_E (" and possibly more lines in between"); + Diag_C ("supercedes line "); + Diag_C (Tree_Cursor.Lineno); + Diag_C (" and possibly more lines in between"); + Warning_E; -- TODO : destroy Tree_Cursor.Next_Child Tree_Cursor.Lineno := Lineno; Tree_Cursor.Next_Child := null; @@ -358,8 +360,9 @@ package body Grt.Wave_Opt.File is -- line. Then /top/a will supercede /top/a/b. if Level > 1 and not Last_Updated then Print_Context (Lineno, Elem_Expr'First, Warning); - Report_C ("superceded by line "); - Report_E (Cursor.Lineno); + Diag_C ("superceded by line "); + Diag_C (Cursor.Lineno); + Warning_E; return; -- TODO : destroy Created_Elem end if; diff --git a/src/grt/grt-wave_opt.adb b/src/grt/grt-wave_opt.adb index 4e94ee300..f976c42bd 100644 --- a/src/grt/grt-wave_opt.adb +++ b/src/grt/grt-wave_opt.adb @@ -36,14 +36,14 @@ package body Grt.Wave_Opt is when Error => Error_S; when Warning => - Report_C ("warning: "); + Warning_S; end case; - Report_C (File_Path.all); - Report_C (":"); - Report_C (Lineno); - Report_C (":"); - Report_C (Column); - Report_C (": "); + Diag_C (File_Path.all); + Diag_C (':'); + Diag_C (Lineno); + Diag_C (':'); + Diag_C (Column); + Diag_C (": "); end Print_Context; procedure Print_Context (Element : Elem_Acc; Severity : Severity_Type) is @@ -57,11 +57,12 @@ package body Grt.Wave_Opt is Severity : Severity_Type := Error) is begin Print_Context (Lineno, Column, Severity); + Diag_C (Msg); case Severity is when Error => - Error_E (Msg); + Error_E; when Warning => - Report_E (Msg); + Warning_E; end case; end Error_Context; |