grt: rework error API (WIP) - rework report, add warning.

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;