Changes in warning/error messages formatting in the Wave_Opt_File pac… (#124)

Changes in warning/error messages formatting in the Wave_Opt_File packages to match better the way ghdl print warning/error messages. A little code cleanup.

8 files changed, 91 insertions, 100 deletions

diff --git a/src/grt/grt-wave_opt_file-parse-debug.adb b/src/grt/grt-wave_opt_file-parse-debug.adb
index 2f8c66ec6..3461c9f3c 100644
--- a/src/grt/grt-wave_opt_file-parse-debug.adb
+++ b/src/grt/grt-wave_opt_file-parse-debug.adb
@@ -29,6 +29,9 @@ with Grt.Astdio; use Grt.Astdio;
 
 package body Grt.Wave_Opt_File.Parse.Debug is
 
+   -- Dump recursively an element of the tree.
+   procedure Dump_Sub_Tree (Cursor : Elem_Acc);
+
    procedure Dump_Tree is
    begin
       New_Line;
@@ -39,22 +42,24 @@ package body Grt.Wave_Opt_File.Parse.Debug is
          else
             Put_Line ("Instances : ");
          end if;
-         Dump_Sub_Tree (Trees (Index), 1);
+         Dump_Sub_Tree (Trees (Index));
       end loop;
       Put_Line ("----------- END -----------------");
       New_Line;
    end Dump_Tree;
 
-   procedure Dump_Sub_Tree (Cursor : Elem_Acc; Level : Positive)
+-------------------------------------------------------------------------------
+
+   procedure Dump_Sub_Tree (Cursor : Elem_Acc)
    is
       Sibling_Cursor : Elem_Acc;
    begin
       Sibling_Cursor := Cursor;
       while Sibling_Cursor /= null loop
-         Put ((3 .. 2 * Level => ' '));
+         Put ((3 .. 2 * Sibling_Cursor.Level => ' '));
          Put ('/');
          Put_Line (Sibling_Cursor.Name.all);
-         Dump_Sub_Tree (Sibling_Cursor.Next_Child, Level + 1);
+         Dump_Sub_Tree (Sibling_Cursor.Next_Child);
          Sibling_Cursor := Sibling_Cursor.Next_Sibling;
       end loop;
    end Dump_Sub_Tree;
diff --git a/src/grt/grt-wave_opt_file-parse-debug.ads b/src/grt/grt-wave_opt_file-parse-debug.ads
index 210076141..dcf2e51e9 100644
--- a/src/grt/grt-wave_opt_file-parse-debug.ads
+++ b/src/grt/grt-wave_opt_file-parse-debug.ads
@@ -32,7 +32,4 @@ private package Grt.Wave_Opt_File.Parse.Debug is
    -- Dump all the tree
    procedure Dump_Tree;
 
-   -- Dump recursively an element of the tree.  Called by Dump_Tree
-   procedure Dump_Sub_Tree (Cursor : Elem_Acc; Level : Positive);
-
 end Grt.Wave_Opt_File.Parse.Debug;
diff --git a/src/grt/grt-wave_opt_file-parse.adb b/src/grt/grt-wave_opt_file-parse.adb
index fe598a9b9..18d29fe37 100644
--- a/src/grt/grt-wave_opt_file-parse.adb
+++ b/src/grt/grt-wave_opt_file-parse.adb
@@ -42,6 +42,7 @@
 --      have the same name after lowering their characters.
 
 with System; use System;
+with Grt.Types; use Grt.Types;
 with Grt.Stdio; use Grt.Stdio;
 with Grt.Strings; use Grt.Strings;
 with Grt.Vstrings; use Grt.Vstrings;
@@ -59,28 +60,28 @@ package body Grt.Wave_Opt_File.Parse is
                         return Boolean;
 
    -- Parse the line where the version is set
-   procedure Parse_Version (Line : String_Access);
+   procedure Parse_Version (Line : String; Line_Pos : Positive);
 
    -- Print the version variable given as parameter
    procedure Print_Version (Version : Version_Type);
 
    -- Parse a line where a signal path is set
-   procedure Parse_Path (Line : String_Access);
+   procedure Parse_Path (Line : in out String);
 
    procedure Start (Option_File : String)
    is
       Stream : constant FILEs := File_Open (Option_File);
       First, Last : Integer;
       Line : String (1 .. Buf_Size);
-      Lineno : Natural;
+      Line_Pos : Natural;
    begin
       File_Path := new String'(Option_File);
-      Lineno := 0;
+      Line_Pos := 0;
 
       -- Processes line after line.
       loop
          exit when fgets (Line'Address, Line'Length, Stream) = Null_Address;
-         Lineno := Lineno + 1;
+         Line_Pos := Line_Pos + 1;
 
          -- Determine end of line.
          Last := New_Line_Pos (Line) - 1;
@@ -96,18 +97,14 @@ package body Grt.Wave_Opt_File.Parse is
 
          -- Create a line string without beginning and ending whitespaces
          Last := Last_Non_Whitespace_Pos (Line (First .. Last));
-         Line_Context := new Line_Context_Type'(
-                                Str => new String'(Line (First .. Last)),
-                                Num => Lineno,
-                                Max_Level => 0);
 
 
          if Line (First) = '$' then
-            Parse_Version (Line_Context.Str);
-            -- TODO : Line_Context should be deallocated here but the memory
-            --        gain shouldn't be significative
+            Parse_Version (Line (First .. Last), Line_Pos);
          else
-            Parse_Path (Line_Context.Str);
+            Path_Context := new Path_Context_Type'(Line_Pos => Line_Pos,
+                                                   Max_Level => 0);
+            Parse_Path (Line (First .. Last));
          end if;
 
          <<Continue>> null;
@@ -131,68 +128,62 @@ package body Grt.Wave_Opt_File.Parse is
 
 -------------------------------------------------------------------------------
 
-   -- An error/warning message start with the context or the error/warning.
-   -- This procedure print this context
-   procedure Print_Context (Severity : Severity_Type);
-
-   -- Print an error/warning with it's context
-   procedure Error_Context (Msg : String; Severity : Severity_Type := Error);
-
-   procedure Parse_Version (Line : String_Access)
+   procedure Parse_Version (Line : String; Line_Pos : Positive)
    is
       Msg_Invalid_Format : constant String := "invalid version format";
       First, Dot_Index, Num : Integer;
    begin
 
       if Version /= (others => -1) then
-         Error_Context ("version is set more than once");
+         Error_Context ("version is set more than once", Line_Pos, Line'First);
       end if;
 
       if Trees /= Tree_Array'(others => null) then
-         Error_Context ("version cannot be set after signal paths");
+         Error_Context
+           ("version cannot be set after signal paths", Line_Pos, Line'First);
       end if;
 
       First := First_Non_Whitespace_Pos (Line (Line'First + 1 .. Line'Last));
       if Line (First .. First + 6) /= "version" then
-         Error_Context (Msg_Invalid_Format);
+         Error_Context (Msg_Invalid_Format, Line_Pos, Line'First);
       end if;
 
       -- Catch "version\n", "version1.0"
       First := First + 7;
       if not Is_Whitespace (Line (First)) then
-         Error_Context (Msg_Invalid_Format);
+         Error_Context (Msg_Invalid_Format, Line_Pos, Line'First);
       end if;
 
       -- Catch "version \n", "version  \n", etc
       First := First_Non_Whitespace_Pos (Line (First + 1 .. Line'Last));
       if First = -1 then
-         Error_Context (Msg_Invalid_Format);
+         Error_Context (Msg_Invalid_Format, Line_Pos, Line'First);
       end if;
 
       -- Catch the absence of "." or "version ."
       Dot_Index := Find (Line (First + 1 .. Line'Last), '.');
       if Dot_Index = -1 then
-         Error_Context (Msg_Invalid_Format);
+         Error_Context (Msg_Invalid_Format, Line_Pos, Line'First);
       end if;
 
       -- Catch version a.2
       Num := Value (Line (First .. Dot_Index - 1));
       if Num = -1 then
-         Error_Context (Msg_Invalid_Format);
+         Error_Context (Msg_Invalid_Format, Line_Pos, Line'First);
       end if;
       Version.Major := Num;
 
       -- Catch version 1.a
       Num := Value (Line (Dot_Index + 1 .. Line'Last));
       if Num = -1 then
-         Error_Context (Msg_Invalid_Format);
+         Error_Context (Msg_Invalid_Format, Line_Pos, Line'First);
       end if;
       Version.Minor := Num;
 
       if Version.Major /= Current_Version.Major
         or else Version.Minor > Current_Version.Minor
       then
-         Print_Context (Error);
+         Print_Context (Line'First, Line_Pos, Error);
          Error_C ("unsupported format version; it must be ");
          if Current_Version.Minor /= 0 then
             Error_C ("between ");
@@ -219,28 +210,30 @@ package body Grt.Wave_Opt_File.Parse is
 
    --------------------------------------------------------------------------
 
-   procedure Parse_Path (Line : String_Access)
+   procedure Parse_Path (Line : in out String)
    is
       -- Can equal to 0 in case of error (like '.' as a full path)
       First, Last : Natural;
       Tree_Updated : Boolean;
       Tree_Index : Tree_Index_Type;
    begin
-      To_Lower (Line_Context.Str.all);
+      To_Lower (Line);
       Last := Line'First;
       if Line (Line'First) = '/' then
          Tree_Index := Entity;
          Last := Last + 1;
          -- Catch '/' as a full path
          if Last > Line'Length then
-            Error_Context ("invalid signal path");
+            Error_Context
+              ("invalid signal path", Path_Context.Line_Pos, Line'First);
          end if;
       else
          -- '/' not allowed for package signal paths in a.  Catch also the
          -- absence a first slash in entity signal paths, which misleads the
          -- code to believe it's inside a package
-         if Find (Line.all, '/') > 0 then
-            Error_Context ("invalid signal path");
+         if Find (Line, '/') > 0 then
+            Error_Context
+              ("invalid signal path", Path_Context.Line_Pos, Line'First);
          end if;
          Tree_Index := Pkg;
       end if;
@@ -261,12 +254,15 @@ package body Grt.Wave_Opt_File.Parse is
             Last := Last + 1;
          end loop;
 
+         Path_Context.Max_Level := Path_Context.Max_Level + 1;
          Tree_Updated := Update_Tree (Line (First .. Last), Tree_Index);
-         Line_Context.Max_Level := Line_Context.Max_Level + 1;
 
          if Last = Line'Last then
             if not Tree_Updated then
-               Error_Context ("ignored already known signal path", Warning);
+               Error_Context ("ignored already known signal path",
+                              Path_Context.Line_Pos,
+                              Line'First,
+                              Warning);
             end if;
             return;
          end if;
@@ -275,7 +271,8 @@ package body Grt.Wave_Opt_File.Parse is
          Last := Last + 2;
          -- Catch signal paths ending with / or .
          if Last > Line'Last then
-            Error_Context ("invalid signal path");
+            Error_Context
+              ("invalid signal path", Path_Context.Line_Pos, Line'First);
          end if;
 
       end loop;
@@ -296,7 +293,9 @@ package body Grt.Wave_Opt_File.Parse is
          -- to no existing element ? Then we will create an element
          if Sibling_Cursor = null then
             Elem := new Elem_Type'(Name => new String'(Elem_Name),
-                                   Line_Context => Line_Context,
+                                   Path_Context => Path_Context,
+                                   Column_Pos => Elem_Name'First,
+                                   Level => Path_Context.Max_Level,
                                    Kind => Not_Found,
                                    Next_Sibling | Next_Child => null);
             -- First element of level ?
@@ -327,16 +326,6 @@ package body Grt.Wave_Opt_File.Parse is
 
    --------------------------------------------------------------------------
 
-   procedure Print_Context (Severity : Severity_Type) is
-   begin
-      Print_Context (Line_Context, Severity);
-   end Print_Context;
-
-   procedure Error_Context (Msg : String; Severity : Severity_Type := Error) is
-   begin
-      Error_Context (Msg, Line_Context, Severity);
-   end Error_Context;
-
    function File_Open (Option_File : String) return FILEs
    is
       Mode : constant String := "rt" & ASCII.Nul;
diff --git a/src/grt/grt-wave_opt_file-parse.ads b/src/grt/grt-wave_opt_file-parse.ads
index 9278c37e2..a0e4ac74b 100644
--- a/src/grt/grt-wave_opt_file-parse.ads
+++ b/src/grt/grt-wave_opt_file-parse.ads
@@ -38,7 +38,7 @@ private
 
    Buf_Size : constant := 1024;
 
-   Line_Context : Line_Context_Acc;
+   Path_Context : Path_Context_Acc;
 
    Tree_Cursor, Previous_Tree_Cursor : Elem_Acc;
 
diff --git a/src/grt/grt-wave_opt_file-tree_reading.adb b/src/grt/grt-wave_opt_file-tree_reading.adb
index f2343be7a..ba3834e50 100644
--- a/src/grt/grt-wave_opt_file-tree_reading.adb
+++ b/src/grt/grt-wave_opt_file-tree_reading.adb
@@ -25,7 +25,6 @@
 
 -- Description: See package specifications
 
-with Grt.Strings; use Grt.Strings;
 with Grt.Errors; use Grt.Errors;
 
 package body Grt.Wave_Opt_File.Tree_Reading is
@@ -67,12 +66,12 @@ package body Grt.Wave_Opt_File.Tree_Reading is
    -- Read the whole sub tree given and check if every element was found in
    -- design.  Called by Check_If_All_Found
    procedure Check_Sub_Tree_If_All_Found
-     (Previous_Cursor : Elem_Acc; Sep : Character; Level : Positive);
+     (Previous_Cursor : Elem_Acc; Sep : Character);
 
    procedure Check_If_All_Found is
    begin
       for Index in Tree_Index_Type'Range loop
-         Check_Sub_Tree_If_All_Found (Trees (Index), Seps (Index), 1);
+         Check_Sub_Tree_If_All_Found (Trees (Index), Seps (Index));
       end loop;
    end Check_If_All_Found;
 
@@ -103,34 +102,24 @@ package body Grt.Wave_Opt_File.Tree_Reading is
    end Find_Cursor;
 
    procedure Check_Sub_Tree_If_All_Found
-     (Previous_Cursor : Elem_Acc; Sep : Character; Level : Positive)
+     (Previous_Cursor : Elem_Acc; Sep : Character)
    is
       Cursor : Elem_Acc;
-      Index : Positive;
    begin
       Cursor := Previous_Cursor;
       while Cursor /= null loop
          if Cursor.Kind = Not_Found then
-            Print_Context (Cursor.Line_Context, Warning);
+            Print_Context (Cursor, Warning);
             Report_C ("no VHDL object in design matches ");
-            -- Display the path of the first unfound vhdl object in signal path
-            if Level > 1 then
-               Index := Cursor.Line_Context.Str'First;
-               for I in 2 .. Level loop
-                  Index := Find (Cursor.Line_Context.Str.all, Sep, Index + 1);
-               end loop;
-               Report_C (Cursor.Line_Context.Str (Cursor.Line_Context.Str'First
-                                                  .. Index));
-            elsif Sep = '/' then
-               Report_C ("/");
-            end if;
             Report_E (Cursor.Name.all);
-         elsif Level = Cursor.Line_Context.Max_Level
+         elsif Cursor.Level = Cursor.Path_Context.Max_Level
            and then Cursor.Kind = Pkg_Entity
          then
-            Error_Context ("not a signal", Cursor.Line_Context, Warning);
+            Print_Context (Cursor, Warning);
+            Report_C (Cursor.Name.all);
+            Report_E (" is not a signal");
          else
-            Check_Sub_Tree_If_All_Found (Cursor.Next_Child, Sep, Level + 1);
+            Check_Sub_Tree_If_All_Found (Cursor.Next_Child, Sep);
          end if;
          Cursor := Cursor.Next_Sibling;
       end loop;
diff --git a/src/grt/grt-wave_opt_file-tree_reading.ads b/src/grt/grt-wave_opt_file-tree_reading.ads
index 1358ac2ca..adeaaeb12 100644
--- a/src/grt/grt-wave_opt_file-tree_reading.ads
+++ b/src/grt/grt-wave_opt_file-tree_reading.ads
@@ -27,6 +27,8 @@
 --              after parsing the wave option file. It provides functions to
 --              find in the tree which signals are to be displayed or not
 
+with Grt.Types; use Grt.Types;
+
 package Grt.Wave_Opt_File.Tree_Reading is
    pragma Preelaborate;
 
diff --git a/src/grt/grt-wave_opt_file.adb b/src/grt/grt-wave_opt_file.adb
index c93c2e885..8147e1bb7 100644
--- a/src/grt/grt-wave_opt_file.adb
+++ b/src/grt/grt-wave_opt_file.adb
@@ -25,16 +25,12 @@
 
 -- Description: See package specifications
 
-with Grt.Vstrings; use Grt.Vstrings;
 with Grt.Errors; use Grt.Errors;
 
 package body Grt.Wave_Opt_File is
 
    procedure Print_Context
-     (Line_Context : Line_Context_Acc; Severity : Severity_Type)
-   is
-      Lineno_Str : String (1 .. Value_String_Size);
-      First : Natural;
+     (Line_Pos, Column_Pos : Positive; Severity : Severity_Type) is
    begin
       case Severity is
          when Error =>
@@ -42,21 +38,25 @@ package body Grt.Wave_Opt_File is
          when Warning =>
             Report_C ("warning: ");
       end case;
-      Report_C ("in file '");
       Report_C (File_Path.all);
-      Report_C ("' at line ");
-      To_String (Lineno_Str, First, Ghdl_I32 (Line_Context.Num));
-      Report_C (Lineno_Str (First .. Lineno_Str'Last));
-      Report_C (" - ");
-      Report_C (Line_Context.Str.all);
-      Report_C (" : ");
+      Report_C (":");
+      Report_C (Line_Pos);
+      Report_C (":");
+      Report_C (Column_Pos);
+      Report_C (": ");
+   end Print_Context;
+
+   procedure Print_Context (Element : Elem_Acc; Severity : Severity_Type) is
+   begin
+      Print_Context
+        (Element.Path_Context.Line_Pos, Element.Column_Pos, Severity);
    end Print_Context;
 
    procedure Error_Context (Msg : String;
-                            Line_Context : Line_Context_Acc;
+                            Line_Pos, Column_Pos : Positive;
                             Severity : Severity_Type := Error) is
    begin
-      Print_Context (Line_Context, Severity);
+      Print_Context (Line_Pos, Column_Pos, Severity);
       case Severity is
          when Error =>
             Error_E (Msg);
@@ -65,4 +65,11 @@ package body Grt.Wave_Opt_File is
       end case;
    end Error_Context;
 
+   procedure Error_Context
+     (Msg : String; Element : Elem_Acc; Severity : Severity_Type := Error) is
+   begin
+      Error_Context
+        (Msg, Element.Path_Context.Line_Pos, Element.Column_Pos, Severity);
+   end Error_Context;
+
 end Grt.Wave_Opt_File;
diff --git a/src/grt/grt-wave_opt_file.ads b/src/grt/grt-wave_opt_file.ads
index 426a73b1d..3999f317c 100644
--- a/src/grt/grt-wave_opt_file.ads
+++ b/src/grt/grt-wave_opt_file.ads
@@ -28,8 +28,6 @@
 --              the help of it's child units)
 --              Contains common stuff for it's child units
 
-with Grt.Types; use Grt.Types;
-
 package Grt.Wave_Opt_File is
    pragma Preelaborate;
 
@@ -38,19 +36,20 @@ package Grt.Wave_Opt_File is
 
    File_Path : String_Cst;
 
-   type Line_Context_Type is record
-      Str : String_Access;
-      Num : Natural;
+   type Path_Context_Type is record
+      Line_Pos : Natural;
       Max_Level : Natural;
    end record;
-   type Line_Context_Acc is access Line_Context_Type;
+   type Path_Context_Acc is access Path_Context_Type;
 
    type Elem_Kind_Type is (Not_Found, Pkg_Entity, Signal);
    type Elem_Type;
    type Elem_Acc is access Elem_Type;
    type Elem_Type is record
       Name : String_Cst;
-      Line_Context : Line_Context_Acc;
+      Path_Context : Path_Context_Acc;
+      Column_Pos : Positive;
+      Level : Positive;
       Kind : Elem_Kind_Type;
       Next_Sibling : Elem_Acc;
       Next_Child : Elem_Acc;
@@ -68,11 +67,14 @@ private
    -- An error/warning message start with the context or the error/warning.
    -- This procedure print this context
    procedure Print_Context
-     (Line_Context : Line_Context_Acc; Severity : Severity_Type);
+     (Line_Pos, Column_Pos : Positive; Severity : Severity_Type);
+   procedure Print_Context (Element : Elem_Acc; Severity : Severity_Type);
 
    -- Print an error/warning with it's context
    procedure Error_Context (Msg : String;
-                            Line_Context : Line_Context_Acc;
+                            Line_Pos, Column_Pos : Positive;
                             Severity : Severity_Type := Error);
+   procedure Error_Context
+     (Msg : String; Element : Elem_Acc; Severity : Severity_Type := Error);
 
 end Grt.Wave_Opt_File;